Macro: assign value of x-y postion

**james.carey** · 05-17-2011, 10:41 AM

Hi,

I need to create a macro which will give the cell of a co-ordinate a value of 1.

Basically I have two columns called X-Position and Y-Postion e.g.

X-Position Y-Position
2 16
6 9

So the marco will take the 2nd row 16th column in and assign that cell the value 1 then take the 6th row and 9th column in assign give the cell value 1 and so on...

**mohd9876** · 05-17-2011, 10:54 AM

assuming the the x and y columns are A and B:

Dim Xpos As Range
Dim r As Range
Set Xpos = Range("A2", Range("A" & Rows.Count).End(xlUp))
For Each r In Xpos
       Cells(r.Value, r.Offset(0, 1).Value) = 1
Next r

**stanleydgromjr** · 05-17-2011, 11:33 AM

james.carey,

Welcome to the Excel forum.

I assume that your coordinates are in columns A and B, and begin in row 2.

The macro will check the coordinates, and if they are not valid, they will be highlighted RED.

Detach/open workbook SetXY coorinates equal to 1 - james_carey - EF776351 - SDG13.xls and run macro SetXY.

If you want to use the macro on another workbook:

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.


Option Explicit
Sub SetXY()
' stanleydgromjr, 05/17/2011
' http://www.excelforum.com/excel-programming/776351-macro-assign-value-of-x-y-postion.html
Dim c As Range
Application.ScreenUpdating = False
For Each c In Range("A2", Range("A" & Rows.Count).End(xlUp))
  If c = "" Or c < 1 Or c > Rows.Count And c.Offset(, 1) = "" Or c.Offset(, 1) < 1 Or c.Offset(, 1) > Columns.Count Then
    c.Resize(, 2).Interior.ColorIndex = 3
  Else
    Cells(c.Value, c.Offset(, 1).Value) = 1
  End If
Next c
Application.ScreenUpdating = True
End Sub

Then run the SetXY macro.