I need a Worksheet_Change macro moving cell to cell

[daniels012]

I need a macro

I start/add a number in cell C3. After I hit enter the cell goes down the column. this is all normal so far. I then get to the last cell in the column (the last cell is the last row that "Column B" has text. After I enter a number in the last row I need the cursor to go to Column D in the last row and now work it's way back up. So I need the Worksheet change to always move down row by row if it is an Odd Column and I need the cursor to go up if it is an even column. Also when it gets to the first row (Row 3 ALWAYS) I need it to move over to the next column.

Please any help with this is greatly appreciated. I did try to ask about this in MrExcel and have not heard a thing in 2 days. I am kind of on a deadline.

Thank YOu,
Michael D

[Bob Phillips]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastrow As Long

If Target.Column > 2 Then

lastrow = Me.Cells(Me.Rows.Count, "B").End(xlUp).Row
If Target.Column Mod 2 = 1 Then

If Target.Row >= lastrow Then

Me.Cells(Target.Row, Target.Column + 1).Select
Else

Me.Cells(Target.Row + 1, Target.Column).Select
End If
Else

If Target.Row = 1 Then

Me.Cells(1, Target.Column + 1).Select
Else

Me.Cells(Target.Row - 1, Target.Column).Select
End If
End If
End If
End Sub

[daniels012]

I think this is close.

The data I have I need this code to work in a range I specify.
For example I use a named range where I want all this to happen.
"Draft Area" which is range C3:P15

I also have existing code. I want to add your code to the end of it. I am sorry I did not say this before. Actually forgot about the other code!!


If Intersect(Target, Range("C3:P15")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Dim BLr As Long, SetRng As Long
BLr = Range("B17").End(xlDown).Row
SetRng = Range("B16").End(xlDown).Row
Range("B17").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
'This was the BLr range after Key: =Range("B15:B127")
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B17", "B" & BLr) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
'Set Range used to be Range("B14:B127")
.SetRange Range("B16", "B" & SetRng)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Target.Select
If Target.Value <> "" Then
Range("C1").Value = Target.Value
Else
End If



Can I just add your code and will it work?

[Bob Phillips]

Try it and see.

[daniels012]

Ok I tried your code and it just kept going on the last row.

not sure why?

[Bob Phillips]

Post the workbook as you have it.

[daniels012]

File is attached

[daniels012]

Through trial and error here is what I have come up with!
If Target.Column > 2 Then

lastrow = Range("A15").Value
' lastrow = Me.Cells(Me.Rows.Count, "B").End(xlDown).Row
If Target.Column Mod 2 = 1 Then

If Target.Row >= lastrow Then

Me.Cells(Target.Row, Target.Column + 1).Select
Else

Me.Cells(Target.Row + 1, Target.Column).Select
End If
Else

If Target.Row = 3 Then

Me.Cells(Target.Row, Target.Column + 1).Select
Else

Me.Cells(Target.Row - 1, Target.Column).Select
End If
End If
End If

I had to add a formula in cell A15 =COUNTA(B3:B15)+2

And also:
If Target.Row = 3 Then

Me.Cells(Target.Row, Target.Column + 1).Select


Thank you for the help. DO you see any future problems that may arise in the code i have come up with?

Thank You