Lookup a value in multiple closed workbooks?

[JumboCactuar]

Hi,
Unsure of the best way to achieve this

Example: this workbook.Sheets("Sheet1").Range("A1") = "OrangeBlue"

I have a folder with 12 files and I want to fetch the row of each workbook where "OrangeBlue" is found.

I know how to loop through and open/close each file, just unsure of the VBA needed for the lookup.

Looking range will be WB2 - Sheet1 - Columns A and the output should be A:F


Any help appreciated

 

[JumboCactuar]

Figured this out myself but maybe it can be improved?

Sub multiLookup()Dim WB1 As Workbook, WB2 As Workbook
Dim WS1 As Worksheet, WS2 As Worksheet
Dim Cl As Range


Application.ScreenUpdating = False


LookupVal = ThisWorkbook.Sheets("sheet1").Range("A1")


'Name of Files to Look through
For Each Cl In Sheets("Variables").Range("A1:A12")
   If Cl.Value <> "" Then
      File1 = Cl.Value
      
      myFile = "C:\test\" & File1 & ".xlsb"
      
      'This workbook
      Set WB1 = ThisWorkbook
      Set WS1 = WB1.Sheets("Sheet1")
      
      'Target workbook
      Set WB2 = Workbooks.Open(myFile)
      Set WS2 = WB2.Sheets("sheet1")
           
      'Perform Lookup
        Set rFound = WS2.Range("A1:A10000").Find(What:=LookupVal, SearchFormat:=True, After:=WS2.Range("A1"), _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, MatchCase:=True)
        
        LR = WS1.Range("A65000").End(xlUp).Row + 1
        
        If Not rFound Is Nothing Then
        WS1.Range("A" & LR) = rFound
        WS1.Range("B" & LR) = rFound.Offset(0, 1)
        WS1.Range("C" & LR) = rFound.Offset(0, 2)
        WS1.Range("D" & LR) = rFound.Offset(0, 3)
        WS1.Range("E" & LR) = rFound.Offset(0, 4)
        WS1.Range("F" & LR) = rFound.Offset(0, 5)
        End If


      WB2.Close
   End If
Next Cl


Application.ScreenUpdating = True
End Sub

 

[JumboCactuar]

Hi,
When I get to this part:
myFile = "C:\test\" & File1 & ".xlsb"

If the file isn't found it throws an error, is there a way I can resume next if the file isn't found?

 

[Fluff]

How about

Sub multiLookup()
Dim WB1 As Workbook, WB2 As Workbook
Dim WS1 As Worksheet, WS2 As Worksheet
Dim Cl As Range


Application.ScreenUpdating = False


LookupVal = ThisWorkbook.Sheets("sheet1").Range("A1")

'This workbook
Set WB1 = ThisWorkbook
Set WS1 = WB1.Sheets("Sheet1")

'Name of Files to Look through
For Each Cl In Sheets("Variables").Range("A1:A12")
   If Cl.Value <> "" Then
      File1 = Cl.Value
      
      myFile = "C:\test\" & File1 & ".xlsb"
      
      
      'Target workbook
      Set WB2 = Nothing
      On Error Resume Next
      Set WB2 = Workbooks.Open(myFile)
      On Error GoTo 0
      If Not WB2 Is Nothing Then
          Set WS2 = WB2.Sheets("sheet1")
               
          'Perform Lookup
            Set rFound = WS2.Range("A1:A10000").Find(What:=LookupVal, SearchFormat:=True, After:=WS2.Range("A1"), _
            LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, MatchCase:=True)
            
            LR = WS1.Range("A65000").End(xlUp).Row + 1
            
            If Not rFound Is Nothing Then
                WS1.Range("A" & LR) = rFound
                WS1.Range("B" & LR) = rFound.Offset(0, 1)
                WS1.Range("C" & LR) = rFound.Offset(0, 2)
                WS1.Range("D" & LR) = rFound.Offset(0, 3)
                WS1.Range("E" & LR) = rFound.Offset(0, 4)
                WS1.Range("F" & LR) = rFound.Offset(0, 5)
            End If
    
    
          WB2.Close
        End If
   End If
Next Cl


Application.ScreenUpdating = True
End Sub

 

[JumboCactuar]

Works perfect
Thanks again @Fluff

 

[Fluff]

You're welcome & thanks for the feedback

 

[JumboCactuar]

Hi @Fluff sorry to be a pain
related to the above code:

With this:

'Name of Files to Look through
For Each Cl In Sheets("Variables").Range("A1:A12")

A12 can be extended

The name of the files are always a date in format DD-MM-YYYY
example: 01-07-2019.xlsx

In Sheet1 i want to set a date range
cell B1 = From Date
cell C1 = To Date

If cell B1 is 26-06-2019 and cell C1 is 01-07-2019

I want the variable range to be populated with these dates before looping (but in newest order)

SO Variables Range("A1:A6") would be populated with:
01-07-2019
30-06-2019
29-06-2019
28-06-2019
27-06-2019
26-06-2019

As cell C1 date is alway higher or equal to B1 Date, im thinking i can use the highest date for Variables.Range("A1") then calculating how many days since the first date

 

[JumboCactuar]

This is my attempt, its weird that my To Date is 01-07-2019

but if i use DD-MM-YYYY in the code below it outputs 07-01-2019 which would be wrong. It must not know which is the month

this works

MaxDate = Sheets("Sheet1").Range("C1").Value
MinDate = Sheets("Sheet1").Range("B1").Value


DayCount = MaxDate - MinDate + 1


Sheets("Variables").Range("A1") = Format(MaxDate, "MM-DD-YYYY")
Sheets("Variables").Range("A2:A" & DayCount).FormulaR1C1 = "=R[-1]C-1"

 

[Fluff]

Dates in VBA are US centric, which is why it's converting your dates.