Select same cell after sorting

[Sandy]

I would like to adjust this code to do the following:

Say that a cell in row 25 is selected and then the code is run,
the sort takes place perfectly but the activecell remains in row 25.
Is it possible to have the activecell move with the sorted rows,
thus retaining the original selection?

Sub RectifyError()

Sheets("View Rounds").Unprotect Password:="pinev85"

Dim LRow As Long

LRow = Cells(Rows.Count, 2).End(xlUp).Offset(0, 0).Row

If Intersect(ActiveCell, Range("B3:F2" & LRow)) Is Nothing Then
MsgBox "You must select within the round you would like to correct",
vbCritical
GoTo EarlyClose
End If

Rows("3:" & LRow).Sort Key1:=Cells(3, 4), _
Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom

'*******
'Select the cell with the data that was originally selected
'*******


EarlyClose:

Sheets("View Rounds").Protect Password:="pinev85"


End Sub

 

[Joel]

Put an X into a auxilary column IV in the selected row. then look for the X
to reselect the cell at the end

Sub RectifyError()

Sheets("View Rounds").Unprotect Password:="pinev85"

Dim LRow As Long
Columns("IV").clearcontents
SelectColumn =selection.Column
Range("IV",Selection.Row) = "X"

LRow = Cells(Rows.Count, 2).End(xlUp).Offset(0, 0).Row

If Intersect(ActiveCell, Range("B3:F2" & LRow)) Is Nothing Then
MsgBox "You must select within the round you would like to correct",
vbCritical
GoTo EarlyClose
End If

Rows("3:" & LRow).Sort Key1:=Cells(3, 4), _
Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom

'*******
'Select the cell with the data that was originally selected
set c = Columns("IV").find(what:="X",lookin:=xlvalues)
Cells(c.row,SelectColumn).Select
Columns("IV").clearcontents

'*******


EarlyClose:

Sheets("View Rounds").Protect Password:="pinev85"


End Sub

 

[Don Guillett]

Sub RectifyError()

Sheets("View Rounds").Unprotect Password:="pinev85"
'==========
mycell = ActiveCell
'==========

Dim LRow As Long


LRow = Cells(Rows.Count, 2).End(xlUp).Offset(0, 0).Row

If Intersect(ActiveCell, Range("B3:F2" & LRow)) Is Nothing Then
MsgBox "You must select within the round you would like to correct",
vbCritical
GoTo EarlyClose
End If

Rows("3:" & LRow).Sort Key1:=Cells(3, 4), _
Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom

'*******
'adjust to your column or use cells.find
Columns(1).Find(mycell).Activate
'Select the cell with the data that was originally selected
'*******


EarlyClose:

Sheets("View Rounds").Protect Password:="pinev85"


End Sub

 

[Sandy]

Joel I could not get the
SelectColumn =selection.Column
Range("IV",Selection.Row) = "X" to work.
Probably my incompetence.

Don
Your solution was great apart from a problem if there was duplicate data
in a selected column.

However I have hybrided (as below) - I am sure it could be silkier
but it works - so thanks to you both.

Sandy

Sub RectifyError()

Sheets("View Rounds").Unprotect Password:="pinev85"

Application.EnableEvents = False

Dim LRow As Long
Dim AColumn As Long
Dim MyCell
Dim MyRow

Columns("I").ClearContents

LRow = Cells(Rows.Count, 2).End(xlUp).Offset(0, 0).Row

If Intersect(ActiveCell, Range("B3:F2" & LRow)) Is Nothing Then
MsgBox "You must select within the round you would like to correct",
vbCritical
GoTo EarlyClose
End If

MyRow = ActiveCell.Row
Range("I" & MyRow).Value = "X"

Range("I" & MyRow).Activate
MyCell = ActiveCell

Rows("3:" & LRow).Sort Key1:=Cells(3, 4), _
Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom

Columns(9).Find(MyCell).Select

MyRow = ActiveCell.Row

Range("B" & MyRow).Select

EarlyClose:

Columns("I").ClearContents

Application.EnableEvents = True
Sheets("View Rounds").Protect Password:="pinev85"


End Sub

***************************************************************