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

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.

Code:

---

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

Code:

---

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

---

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

Code:

---

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

---

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!!!

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

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.

Quote:

---

Originally Posted by 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.

---

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