I am new to coding and have been working on trying to make a code that has 3 functions but I am really struggling as this is significantly harder than I thought haha.

The goal is to use a reference excel workbook used as a database to find matching BoxID and then copy cells D to G in the same row. Finally pasting to another workbook that consists of a single worksheet. I figured Xlookup would be the easiest way to do this but I have not been successful with it. Using it in excel works fine but it doesn't work as well in VBA.

3 main questions/going I have for posting is

• How do I open another workbook and then reference all sheets or a specific range through all sheets in a dynamically named workbook to my current activeworkbook. (ie sheets will be named freezer 23,freezer 43, fridge 190 in data base) The rows of the sheets is variable but the columns stay the same.
• Is there a way to do the above but if nothing is found to leave the cell blank if there is no match found
• Is there a way I could simplify this code?

On the left is the database which is going to be the external reference/where the data is coming from and on the right is the output sheet. Where I will be using Xlookup to search for the matching value. column "A" is where the search value will be and output to the next 4 cells.

Sub FreezerPulls()
    
    Dim lastrow, j As Long
    lastrow = Cells(Rows.Count, 1).End(xlUp).Row
    Dim a As Integer
    Dim list As Workbook
    Dim frzdatabase As 
    
    Dim BoxIDlist, info, BoxIDdatabase, database, databasepath As String
    
    
    databasepath = ("C:\Users\mikeo\Desktop\DataBaseStandard.xlsm")
    Workbooks.Open ("C:\Users\mikeo\Desktop\DataBaseStandard.xlsm")
    
    database = "DataBaseStandard.xlsm"
    Set list = ThisWorkbook
    
    list.Activate
    
    Set BoxIDlist = Worksheets("Sheet1").Range("A" & Row.Count).End(xlUp).Row  'emphasized textthis doesn't work
    Set BoxIDdatabase = Range("A2:A1500")
    Set info = Range("D2:G1500")
    
    a = Application.Worksheets.Count
    
End Sub

CodePudding user response：

You could do something like this, using Match(). See comments in code

Sub FreezerPulls()
    
    Const DB_PATH As String = "C:\Users\mikeo\Desktop\DataBaseStandard.xlsm"
    Dim wbData As Workbook, ws As Worksheet, rw As Range, id, m
    
    Set wbData = Workbooks.Open(DB_PATH, ReadOnly:=True) 'get a reference to the data workbook
    
    'loop each row in the lookup table
    For Each rw In ThisWorkbook.Sheets("Sheet1").Range("A17:F40").Rows
        id = rw.Cells(1).Value                                'Box ID to find
        If Len(id) > 0 Then                                   'any value to look up?
            For Each ws In wbData.Worksheets                  'loop all worksheets in data workbook
                m = Application.Match(id, ws.Columns("A"), 0) 'any match on this sheet ColA?
                If Not IsError(m) Then                        'no error = match was made on row m
                    rw.Cells(3).Value = ws.Name               'add freezer name
                    rw.Cells(4).Resize(1, 3).Value = _
                          ws.Cells(m, 5).Resize(1, 3).Value   'copy segment, rackID, position
                    Exit For                                  'done searching (assumes box id's are unique)
                End If
            Next ws
        End If
    Next rw
    
    wbData.Close False

End Sub