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

Hi guys,

I'm very new to this and just getting into programming so looking for some assistance with getting this Project going. I was after a macro that would search for a unique id such as 'CBX495-1' in column A, Row1 of one workbook (Workbook1) containing only one worksheet, in another workbook (Workbook2), containing multiple worksheets, using Workbook2's file name and path. I would like the macro to list where the unique id can be found in Column B of workbook 2.
I would also like the Macro to move on to Row 2, Column A of Workbook one and repeat this until all rows in Workbook1 have been searched.
Is this possible in excel?

Any assistance would be greatly appreciated.

Many thanks,
Tim.

Hi Tim,

Yes this is possible. Do you have sample files that you can upload?

Hi Arlette,

Thanks for getting back to me so quickly. I have uploaded two files. File 'G_W_P' would be workbook1 and File 'G&W - S&C' would be workbook2. As mentioned in my original post. I was hoping the macro could look for a unique id# that it gets from Row 2 of Column A of 'G_W_P' within each worksheet of 'G&W - S&C' and when it finds that unique id, list the location of the worksheet in Column B of 'G_W_P' next to the unique id. I was hoping it could repeat this for the entire list in Column A of 'G_W_P'.
I'm hoping that the macro will only display results that exactly match the unique Id#, and not numbers that contain the unique id but are different. For example, if unique id# 'CBX246' is searched, results should not include unique id#'s such as 'CBX246-1' or 'CBX246-2'.

Thanks again for your help.

Is the below what you wanted?

Public Sub FindID()
     Dim wkb1 As Workbook
     Dim wkb2 As Workbook
     Dim wks1 As Worksheet
     Dim wks2 As Worksheet
     Dim lngLastRow As Long
     Dim lng As Long
     Dim str As String
     Dim rng As Range
     
     Set wkb1 = ThisWorkbook
     Set wkb2 = Workbooks.Open(wkb1.Path & "\G&W - S&C.xlsx") 'assumes wkb1 & wkb2 are in the same directory
     
     Set wks1 = wkb1.Worksheets("20120405-Gathering_Well_Propose")
     
     lngLastRow = wks1.Cells(wks1.Rows.Count, 1).End(xlUp).Row
     
     For lng = 2 To lngLastRow
          str = wks1.Cells(lng, 1).Value
          For Each wks2 In wkb2.Worksheets
               Set rng = wks2.Cells.Find(What:=str, LookAt:=xlWhole) 'finds first (only) match in a worksheet
               If Not (rng Is Nothing) Then
                    wks1.Cells(lng, 1).Offset(0, 1).Value = "[" & wkb2.Name & "].[" & wks2.Name & "]." & rng.Address(False, False)
                    Exit For
               End If
          Next wks2
     Next lng
End Sub

Try this:

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 & "\G&W - S&C.xlsx") 'assumes wkb1 & wkb2 are in the same directory
     Set wks1 = wkb1.Worksheets("20120405-Gathering_Well_Propose")
     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

I've updated my code to include some error handling (a Try/Catch/Finally methodology I use a lot).
If there's an error it'll pause at the 'Stop: Resume' line on 'Stop'.
You can then just step into the code (using F8). You'll see it move to 'Resume' then F8 again and it'll take you to the offending line of code.
Let me know which one it is.
If it, instead, 'runs and never stop' then there's a problem with the condition on my Do...While loop which will require further investigation (maybe you could post some offending files and give me an idea of where I should locate them on my machine, ie. directories for them).

Timmo246,

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code. Posting code without them makes your code hard to read and difficult to be copied for testing. Highlight your code and click the # at the top of your post window. For more information about these and other tags, found here