Select Cell Data Last Entered Into After Auto-Sort

[LBinGA]

Hello all!

I have the following code that auto-sorts my table based on a value in column F. Once sorted, the cursor goes to the bottom of the table. How would I change this code to force the cursor to "follow" the cell in which data was last entered after the sort? The cell is dynamic because of the sort, and not static.

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim finalRow As Integer
Dim i As Integer
Dim erow As Long

erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Range("f:f").Select
Range("b2").Sort Key1:=Range("f2"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
If Cells(erow - 1, 1).Offset(0, 1) = "" Then
Cells(erow - 1, 1).Offset(0, 1).Select
Else
Cells(erow, 1).Select
End If
 
    finalRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    Range("A1:A" & finalRow).EntireRow.AutoFit
    
    For i = 2 To finalRow
        If Range("A" & i).EntireRow.RowHeight < 27 Then
            Range("A" & i).EntireRow.RowHeight = 27
        If Range("D" & i).EntireRow.RowHeight < 27 Then
          Range("D" & i).EntireRow.RowHeight = 27
        End If
        End If
            Next i
    
    On Error Resume Next
 
End Sub

Thanks in advance,

LBinGA

 

[mikerickson]

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim finalRow As Integer
Dim i As Integer
Dim erow As Long

[COLOR="#FF0000"]Dim tCell as Range, tValue as Variant
Set tCell = Target.Cells(1,1)
Set tValue = tCell.Value[/COLOR]

erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Range("f:f").Select
Range("b2").Sort Key1:=Range("f2"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

[COLOR="#FF0000"]'If Cells(erow - 1, 1).Offset(0, 1) = "" Then
'Cells(erow - 1, 1).Offset(0, 1).Select
'Else
'Cells(erow, 1).Select
'End If[/COLOR]
 
    finalRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    Range("A1:A" & finalRow).EntireRow.AutoFit
    
    For i = 2 To finalRow
        If Range("A" & i).EntireRow.RowHeight < 27 Then
            Range("A" & i).EntireRow.RowHeight = 27
        If Range("D" & i).EntireRow.RowHeight < 27 Then
          Range("D" & i).EntireRow.RowHeight = 27
        End If
        End If
            Next i
    
    On Error Resume Next
  [COLOR="#FF0000"]  tCell.EntireColumn.Find(what:=tValue, LookAt:= xlWhole).Select[/COLOR]
End Sub

 

[LBinGA]

Very interesting! Thank you. It works for the most part. I was getting a Runtime Error 13: Type Mismatch, so I took "Set" out of the tvalue, as bolded below:

Private Sub Worksheet_Change(ByVal Target As Range)Dim finalRow As Integer
Dim i As Integer
Dim erow As Long
Dim tCell As Range, tValue As Variant


Set tCell = Target.Cells(1, 1)
[B]tValue = tCell.Value[/B]


erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Range("f:f").Select
Range("b2").Sort Key1:=Range("f2"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


If Cells(erow - 1, 1).Offset(0, 1) = "" Then
Cells(erow - 1, 1).Offset(0, 1).Select
Else
Cells(erow, 1).Select
End If
 
    finalRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    Range("A1:A" & finalRow).EntireRow.AutoFit
    
    For i = 2 To finalRow
        If Range("A" & i).EntireRow.RowHeight < 27 Then
            Range("A" & i).EntireRow.RowHeight = 27
        If Range("D" & i).EntireRow.RowHeight < 27 Then
          Range("D" & i).EntireRow.RowHeight = 27
        End If
        End If
            Next i
    
    On Error Resume Next
    tCell.EntireColumn.Find(what:=tValue, LookAt:=xlWhole).Select
End Sub

In doing so, the cursor goes to the first number/score that matches the number entered in the column. There may be duplicate scores in the column so this creates a problem.

Example: If the last item in the list is scored 39, the sheet re-sorts the rows and the cursor lands on the first score of 39 it 'sees' in the column, which may or may not be the entry just made.

Is there an adjustment for the cursor staying with the entry made?

Thanks,

LBinGA

 

[LBinGA]

Anyone have a possible solution for keeping the cursor with the last cell entered on auto-sort? The code above, while great, doesn't take into account duplicates in the column.

Thanks,
LBinGA

 

[mikerickson]

Is there a column that has a unique identifier?

 

[LBinGA]

Is there a column that has a unique identifier?

It's a list of ideas that are scored, so Column A is unique, it's idea column so full of text. Could that work?

LBinGA

 

[mikerickson]

Change these lines at the beginning

Set tCell = Target.EntireRow.Cells(1,1)
Set tValue = tCell.Value

and this at the end

tCell.EntireColumn.Find(what:=tValue, LookAt:= xlWhole).Cells(1, 7).Select

 

[LBinGA]

Perfect! I changed the bottom code to (1,1) and the cursor stays with the column entered. Beautifully done...thank you so much!

LBinGA