VBA Help - Search Column For String, Do Something, Repeat Search

[Johnny Thunder]

Hello all I am working with a code that does multiple Loops thru Sheets based on a Matrix, the Matrix contains a Product ID that will need to be searched on specific sheets. For this search, there will always be at least one value found on the sheet the code navigates too. Search column will always be Column C on each sheet.

So what I need is to have the .Find function look at Range("C7:C" & LastRow) and find the Product ID, once found Get the Cell.Row and then Do Something, once that something is done, continue the search in that column, if the Product ID is not found then stop the search.

Finding the first product ID in this code is the easy part, I am struggling with how to write code to have it essentially loop the search and not look at the first value the search found. Any help is appreciated.

*FYI - I am not able to use a Scripting Dictionary in the event anyone was going to propose that idea.

 

[dmt32]

Hi,
Range.FindNext method should do what you require

taken from VBA helpfile

With Worksheets(1).Range("a1:a500")
     Set c = .Find(2, lookin:=xlValues)
     If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.Value = 5
            Set c = .FindNext(c)
        If c is Nothing Then
            GoTo DoneFinding
        End If
        Loop While c.Address <> firstAddress
      End If
      DoneFinding:
End With

Adjust as required


Dave

 

[Kenneth Hobson]

Sub Main()
    Dim ws As Worksheet, r As Range, c As Range, d As Long, ID, s As Sheets, a
    
    ID = 12345
    Set s = Worksheets(Split("Sheet1,Sheet2,Sheet3", ","))
    'Set s = Sheets  'All sheets
    
    For Each ws In s
        Set r = ws.Range("C7", ws.Cells(Rows.Count, "C").End(xlUp))
        If (r.Row >= 7) Then
            d = d + WorksheetFunction.CountIf(r, "=" & ID)
        End If
    Next ws
    
    ReDim a(1 To d)
    d = 0
    For Each ws In s
        Set r = ws.Range("C7", ws.Cells(Rows.Count, "C").End(xlUp))
        If (r.Row >= 7) Then
            For Each c In r
                If (c = ID) Then
                    d = d + 1
                    a(d) = c.Address(external:=True)
                End If
            Next c
        End If
    Next ws

    MsgBox Join(a, vbLf)
End Sub

 

[Johnny Thunder]

That worked great! Thanks for the help on that.