VBA Macro to search for unique ID from one file in multiple sheets of another file

Hi Ping Ping,

Thank you so much for your help. That code is fantastic and is far and away better than what I had written.

Is it possible for the macro to search for multiple listings of the same unique ID , incase of double ups in sheets and list them in Column B, C, D etc. of "G_W_P.xlsm"
Also, could the macro create a new sheet in "G_W_P.xlsm" and display the unique ID's that were searched for in "G&W - S&C.xlsx" but not found?

Thanks so much for taking the time to help me with this one.

Tim.

That's awesome thanks Ping Ping. It works really well as I'm sure you know.
Can you tell me why it doesn't work in different files that are set up the same way and in the same directory?

I run the macro in a different spreadsheet that is set up the same way as wb1 & wb2, checking nearly the same unique ID's and it either runs and never stops or it gives me an application error.

I change the workbook path for WB1 and the spreadshet name WB2 in the code but no luck.

Hi Ping Ping,

Thanks again for your help. You're very generous with your time and knowledge.

I've included my code below, which is using a different filenames and worksheet names.

The code is halting on the last 'Stop' command. I hit F8 repeatedly but the it never steps away from that line of code. Hope this helps, if not I'll post some offending files tomorrow.

Many thanks again,
Tim.

Public Sub FindID2()
On Error GoTo Catch

Try:
Dim dct As Object: Set dct = CreateObject("Scripting.Dictionary")

Dim wkb1 As Workbook
Dim wkb2 As Workbook
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Dim lngRowLast As Long
Dim lng As Long
Dim lngCount As Long
Dim rng As Range
Dim strToFind As String
Dim strCellRef As String
Dim strFirstAddress As String
Dim var As Variant


Set wkb1 = ThisWorkbook
Set wkb2 = Workbooks.Open(wkb1.Path & "\Golden and Wathen - Scout_completion_status(18 3 12).xlsx") 'assumes wkb1 & wkb2 are in the same directory
Set wks1 = wkb1.Worksheets("20120405-Gathering_Flowline_Pro")
lngRowLast = wks1.Cells(wks1.Rows.Count, 1).End(xlUp).Row

' loop through each row in wks1
For lng = 2 To lngRowLast

dct.RemoveAll
strToFind = wks1.Cells(lng, 1).Value

' loop through each worksheet in wkb2
For Each wks2 In wkb2.Worksheets

Set rng = wks2.Cells.Find(What:=strToFind, LookAt:=xlWhole) 'finds first (only) match in a worksheet
If (Not rng Is Nothing) Then
strFirstAddress = rng.Address
Do

strCellRef = "[" & wkb2.Name & "].[" & wks2.Name & "]." & rng.Address(False, False)
If Not (dct.Exists(strCellRef)) Then Call dct.Add(strCellRef, "")
Set rng = wks2.Cells.FindNext(rng)

Loop While (Not rng Is Nothing And rng.Address <> strFirstAddress)
End If

Next wks2

' output the search results to wks1
lngCount = 1
For Each var In dct.Keys
wks1.Cells(lng, 1).Offset(0, lngCount).Value = CStr(var)
lngCount = lngCount + 1
Next var
Next lng

' widen columns to enable easy reading
wks1.Columns.AutoFit

' add worksheet to dump 'Not Found' IDs
Set wks2 = wkb1.Worksheets.Add

Set rng = wks1.UsedRange
With rng

' apply filter
Call .AutoFilter(2, "=")

' copy rows to new worksheet
Call .SpecialCells(xlCellTypeVisible).Copy(wks2.Range("A1"))

End With

' turn off filter
wks1.AutoFilterMode = False

Finally:
Exit Sub

Catch:
Stop: Resume

End Sub