Macro to find unique cell in column

[gmodrow]

Hi,
I'm looking for a quick macro that moves the cursor to the next cell in the current column that does not match the current cell's value.

The following code works but is VERY inefficient.

Sub MoveDown()Application.ScreenUpdating = False
    Do
        ActiveCell.Offset(1, 0).Select
    Loop Until ActiveCell <> ActiveCell.Offset(-1, 0)
Application.ScreenUpdating = True
End Sub

I had a macro that did this instantaneously but I lost it with a harddrive crash. Please help!

 

[hippiehacker]

this should work:

Sub unique()
application.screenupdating = false
Do Until ActiveCell.Value <> ActiveCell.Offset(1, 0).Value
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(1, 0).Select
End Sub

 

[gmodrow]

This works at about the same speed as my current code. I'm working through about 200k lines of code and this takes a few seconds; the previous macro was literally instantaneous.

This moves the cell each time there is not a match. Can't you just determine what cell that is and then move the cursor to that?

 

[Marcelo Branco]

See if this is faster

Sub aTest()
    Dim r As Variant, dataRange As Range, i As Long
    
    Set dataRange = Range(ActiveCell, ActiveCell.EntireColumn.Cells(Rows.Count).End(xlUp))
    r = dataRange
    For i = 1 To dataRange.Rows.Count
        If r(i, 1) <> r(i + 1, 1) Then Exit For
    Next i
    Cells(i + ActiveCell.Row, ActiveCell.Column).Activate
End Sub

M.

 

[gmodrow]

That's it! I remember the code now that I've seen it. And yes it moves perfectly (instantly).

Thanks Marcelo - very appreciated.

 

[Marcelo Branco]

You are welcome and thanks for the feedback!

M.