Looping through IDs and outputting locations where they appear in a new sheet?

[thechans7]

I have a sheet called "IDs" that contains a couple Ids. I want to loop through through each one and find the location/s where each on appears and output the location/s in a new sheet called "Results". How would I do that?

Currently right now, I have a VBA macro that loops through each Id BUT it only puts the last location where each Id was located. So I only get 4 outputs.

Sub findIds()
Dim i As Long, temp As String
Dim A As Integer
Dim firstAddress As String
Dim sht As Worksheet
Dim c As Range
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
    temp = Cells(i, "A").Value
    For Each sht In ActiveWorkbook.Sheets
    
        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 + ": "
                
            End If
        End With
    Next sht
Next i
End Sub

 

[RobP]

Hi,

its because you are not changing your output row every time you populate your Result sheet. (you are using i which is just counting the instances on your first sheet).

Try this:

Sub findIds()
Dim i, output_row As Long, temp As String
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
    
        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" & output_row) = firstAddress + ": " & sht.Name + ": "
                output_row = output_row + 1
            End If
        End With
    Next sht
Next i
End Sub