Return all location in workbook with text is found?

[XcelNoobster]

So I have a sheet called "IDs" that has a list of Ids and a sheet called "Results". I want to look through each Id, search all the sheets and print all the location where each ID is found in "Results" print them on seperate cells.
So currently right now, my macro is printing only the last location where the Id is found in one cell instead of printing each location on a different cells.

Sub findIds()
Dim i As Long, temp As String
Dim output_row As Long
Dim A As Integer
Dim firstAddress As String
Dim sht As Worksheet
Dim c As Range

output_row = 1

For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
    temp = Cells(i, "A").Value
    For Each sht In ActiveWorkbook.Sheets
        If sht.Name = "IDs" Then
            'Do Nothing
        Else
         With sht.Cells
        
          Set Rng = .Find(What:=temp, After:=ActiveCell, LookIn:=xlFormulas, _
             LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
             MatchCase:=False, SearchFormat:=False)
        
            If Not Rng Is Nothing Then
                firstAddress = Rng.Address
                Sheets("Results").Range("D" & i) = firstAddress + ": " & sht.Name + ": "
                output_row = output_row + 1
            End If
        End With
        End If
    Next sht
Next i
End Sub

 

[mumps]

Try:

Sub findIds()
    Application.ScreenUpdating = False
    Dim srcRng As Range, rng As Range, sAddr As String, fnd As Range, ws As Worksheet, x As Long: x = 1
    Set srcRng = Sheets("IDs").Range("A2", Sheets("IDs").Range("A" & Rows.Count).End(xlUp))
    For Each rng In srcRng
        For Each ws In Sheets
            If ws.Name <> "IDs" And ws.Name <> "Results" Then
                Set fnd = ws.Cells.Find(rng, LookIn:=xlValues, lookat:=xlPart)
                If Not fnd Is Nothing Then
                    sAddr = fnd.Address
                    Do
                        With Sheets("Results")
                            .Range("D" & x) = fnd.Address + ": " & ws.Name + ": "
                            x = x + 1
                        End With
                        Set fnd = ws.Cells.FindNext(fnd)
                    Loop While fnd.Address <> sAddr
                    sAddr = ""
                End If
            End If
        Next ws
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[dmt32]

another update to your code that may (or may not) do what you want

Option Explicit
Sub findIds()
    Dim IDarr           As Variant, ID As Variant
    Dim sht             As Worksheet, wsID As Worksheet, wsResults As Worksheet
    Dim FirstAddress    As String
    Dim output_row      As Long
    Dim FoundCell       As Range
    Dim WholeOrPart     As XlLookAt
   
    Set wsID = ThisWorkbook.Worksheets("IDs")
    Set wsResults = ThisWorkbook.Worksheets("Results")
   
    IDarr = wsID.Cells(1, 1).Resize(wsID.Cells(wsID.Rows.Count, "A").End(xlUp).Row, 1).Value
   
    'change Find lookAt as required
    WholeOrPart = xlWhole
   
    For Each ID In IDarr
        For Each sht In ThisWorkbook.Worksheets
            If IsError(Application.Match(sht.Name, Array(wsID.Name, wsResults.Name), 0)) Then
           
                Set FoundCell = sht.Cells.Find(What:=ID, LookIn:=xlValues, LookAt:=WholeOrPart, _
                                              SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                              MatchCase:=False, SearchFormat:=False)
               
                If Not FoundCell Is Nothing Then
                    FirstAddress = FoundCell.Address
                    Do
                        output_row = output_row + 1
                        wsResults.Cells(output_row, 4).Value = FoundCell.Address + ": " & sht.Name + ": "
                        Set FoundCell = sht.Cells.Find(FoundCell)
                    Loop Until FoundCell.Address = FirstAddress
                End If
               
            End If
           
            Set FoundCell = Nothing
            FirstAddress = ""
           
        Next sht
    Next ID
End Sub

Solution reads your IDs in to an array which reduces sheet access a little.

note that I changed what Find looks at (whole or part) to xlWhole - you can change it back to part where shown in bold if needed

Hope Helpful

Dave