need macro added to current to automatically move to next row for next search and

[estatefinds]

I need a code added to this code; so when I select the data in column C and run the macro to do its search and once the search is completed it will highlight that selected data to Yellow to show it has been done.

when I run program again it will automatically move down one row in column C to the un highlighted data, and once the search is done it will highlight yellow.


Essentially the column C is a list in which I run a search from the data in each cell in column C one at a time. and the once I do a search it will highlight in yellow to show that I had done a search from that cell in column C already.

Sub Test()
    If Selection.Column <> 3 Or Selection = "" Then Exit Sub
    Set Data = Sheets("Sheet1").Range("E1:AM9548")
    Data.Interior.Color = xlNone
    n = Split(Replace(Replace(Selection, " ", ""), "-", ","), ",")
    a = Chr(34) & "-" & n(0) & "-" & Chr(34) & ","
    b = Chr(34) & "-" & n(1) & "-" & Chr(34) & ","
    c = Chr(34) & "-" & n(2) & "-" & Chr(34) & ","
    d = Chr(34) & "-" & n(3) & "-" & Chr(34) & ","
    e = Chr(34) & "-" & n(4) & "-" & Chr(34)
    arr = "{" & a & b & c & d & e & "}"
    With Data.SpecialCells(2)
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
        
        For Each cel In .SpecialCells(2)
            f = Chr(34) & "-" & Replace(cel, " ", "") & "-" & Chr(34)
            Z = Evaluate("Count(Find(" & arr & ", " & f & "))")
            Select Case Z
            Case 5
                cel.Interior.Color = 255
            Case 4
                cel.Interior.Color = 682978
            Case 3
                cel.Interior.Color = 15773696
            End Select
        Next cel
    End With
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
   
End Sub

any Help is Greatly Appreciated!!!
Thank you very much in Advance!!!!
Sincerely Dennis

[SamT]

Sub TestList()
Dim Cel As Range

'Add reference to sheet if needed
For each Cel in Intersect(Range("C:C"), UsedRange)
If Not Cel = "" Or Cel.Interior.Color = ??? Then 'Add Yellow Color Number
Cel.Select
Test Selection 'Edit "Test" to reflect actual name of sub in your post.
Cel.Interior.Color = ??? 'Add Yellow Color Number
Next
End Sub

[p45cal]

or add the following two lines at the end of your existing sub:

Selection.Interior.Color = vbYellow
Selection.Offset(1).Select

[estatefinds]

Thank you!!! I appreciated it. I had gone with the suggestion of P45cal post #3 for simplar addition to existing code, but Will use the code you submitted in the future!!!
Thank you very much!!!

[estatefinds]

Thank you very much
this code actually fit into this code Seamlessly Thank you !!!
I appreciate very much!!!!!
Thank you again!!!

[mdmackillop]

As you are dealing with one cell, you should use ActiveCell rather than Selection. I suspect your code will fail if more than one cell is selected.

[SamT]

As you are dealing with one cell, you should use ActiveCell rather than Selection. I suspect your code will fail if more than one cell is selected.

That's one reason I wrote TestList the way I did. One Cell a ta a time