How do I write VBA code which searches multiple sheets on multiple workbooks for cell values, then returns all offset row data

Question

I have a directory which contains multiple workbooks, some of these workbooks are in sub folders. I need to write VBA code which takes the values listed in column A on the only sheet on my source workbook ("values_to_find.xlsm").

The cell values I need to search for are on column A on some worksheets and column B on others. On some worksheets the values start from row 3 and on others row 5.

I need the code to return all offset values to the right of the found cell value and paste it to the right of the column A value on "values_to_find.xlsm". There are up to 27 offset values to return

I have struggled to write code which looks up using the directory, and have had to use multiple file paths. The code runs without error-ing but isn't finding all entries.

All help very gratefully received

 Sub CopyValues()
 Dim wbX As Workbook
 Dim wbY As Workbook
 Dim wsX As Worksheet
 Dim wsY As Worksheet
 Dim lastRowX As Long
 Dim lastRowY As Long
 Dim searchRange As Range
 Dim foundCell As Range
 Dim copyRange As Range

 Set wbX = Workbooks.Open("C:\Users\BRTY\OneDrive\Documents\values_to_find.xlsm")
 Set wsX = wbX.Sheets("Sheet1")
 lastRowX = wsX.Cells(wsX.Rows.Count, "A").End(xlUp).Row

 Set wbY = Workbooks.Open("Z:\ Team\Spreadsheets\TRACK\ Tracker.xlsm")
 Set wbY = Workbooks.Open("Z:\ Team\Spreadsheets\TRACKERS\2022 Trackers\Tracker - Jan22.xlsx")
 Set wbY = Workbooks.Open("Z:\ Team\Spreadsheets\TRACKERS\2022 Trackers\Tracker - May 22.xlsx")
 Set wbY = Workbooks.Open("Z:\ Team\Spreadsheets\TRACKERS\2022 Trackers\Tracker - March 22.xlsx")
 Set wbY = Workbooks.Open("Z:\ Team\Spreadsheets\TRACKERS\2022 Trackers\Tracker - Feb 22.xlsx")
 Set wbY = Workbooks.Open("Z:\ Team\Spreadsheets\TRACKERS\2022 Trackers\ Tracker-April.xlsx")
 Set wbY = Workbooks.Open("Z:\ Team\Spreadsheets\TRACKERS\2022 Trackers\Copy of JUNE 2022 MONTHLY    TRACKER_.xlsx")
 Set wbY = Workbooks.Open("Z:\ Team\Spreadsheets\TRACKERS\2022 Trackers\Copy of Copy of Tracker-July             2022.xlsx")
 Set wbY = Workbooks.Open("Z:\ Team\Spreadsheets\TRACKERS\2022 Trackers\Copy of Tracker - August 2022.xlsx")
 Set wbY = Workbooks.Open("Z:\ Team\Spreadsheets\TRACKERS\2022 Trackers\TRACKER SEPT-2022 NEW.xlsx")
 Set wbY = Workbooks.Open("Z:\ Team\Spreadsheets\TRACKERS\2022 Trackers\Copy of Tracker-OCTOBER 2022.xlsx")
 Set wbY = Workbooks.Open("Z:\ Team\Spreadsheets\TRACKERS\2022 Trackers\November Tracker 2022.xlsx")
 Set wbY = Workbooks.Open("Z:\ Team\Spreadsheets\TRACKERS\2022 Trackers\Copy of Tracker - December 2022.xlsx")

      
For Each wsY In wbY.Sheets
lastRowY = wsY.Cells(wsY.Rows.Count, "A").End(xlUp).Row
Set searchRange = wsY.Range("A1:B" & lastRowY)

For Each cellX In wsX.Range("A1:A" & lastRowX)
  Set foundCell = searchRange.Find(cellX.Value, LookIn:=xlValues)

  If Not foundCell Is Nothing Then
    Set copyRange = foundCell.Offset(0, 1)
    cellX.Offset(0, 1).Value = copyRange.Value
    Set copyRange = foundCell.Offset(0, 2)
    cellX.Offset(0, 2).Value = copyRange.Value
    Set copyRange = foundCell.Offset(0, 3)
    cellX.Offset(0, 3).Value = copyRange.Value
    Set copyRange = foundCell.Offset(0, 4)
    cellX.Offset(0, 4).Value = copyRange.Value
    Set copyRange = foundCell.Offset(0, 5)
    cellX.Offset(0, 5).Value = copyRange.Value
    Set copyRange = foundCell.Offset(0, 6)
    cellX.Offset(0, 6).Value = copyRange.Value
    Set copyRange = foundCell.Offset(0, 7)
    cellX.Offset(0, 7).Value = copyRange.Value
    Set copyRange = foundCell.Offset(0, 8)
    cellX.Offset(0, 8).Value = copyRange.Value
    Set copyRange = foundCell.Offset(0, 9)
    cellX.Offset(0, 9).Value = copyRange.Value
    Set copyRange = foundCell.Offset(0, 10)
    cellX.Offset(0, 10).Value = copyRange.Value
    Set copyRange = foundCell.Offset(0, 11)
    cellX.Offset(0, 11).Value = copyRange.Value
    Set copyRange = foundCell.Offset(0, 12)
    cellX.Offset(0, 12).Value = copyRange.Value
    Set copyRange = foundCell.Offset(0, 13)
    cellX.Offset(0, 13).Value = copyRange.Value
    Set copyRange = foundCell.Offset(0, 14)
    cellX.Offset(0, 14).Value = copyRange.Value
    Set copyRange = foundCell.Offset(0, 15)
    cellX.Offset(0, 15).Value = copyRange.Value
    Set copyRange = foundCell.Offset(0, 16)
    cellX.Offset(0, 16).Value = copyRange.Value
    Set copyRange = foundCell.Offset(0, 17)
    cellX.Offset(0, 17).Value = copyRange.Value
    Set copyRange = foundCell.Offset(0, 18)
    cellX.Offset(0, 18).Value = copyRange.Value
    Set copyRange = foundCell.Offset(0, 19)
    cellX.Offset(0, 19).Value = copyRange.Value
    Set copyRange = foundCell.Offset(0, 20)
    cellX.Offset(0, 20).Value = copyRange.Value
    Set copyRange = foundCell.Offset(0, 21)
    cellX.Offset(0, 21).Value = copyRange.Value
    Set copyRange = foundCell.Offset(0, 22)
    cellX.Offset(0, 22).Value = copyRange.Value
    Set copyRange = foundCell.Offset(0, 23)
    cellX.Offset(0, 23).Value = copyRange.Value
    Set copyRange = foundCell.Offset(0, 24)
    cellX.Offset(0, 24).Value = copyRange.Value
    Set copyRange = foundCell.Offset(0, 25)
    cellX.Offset(0, 25).Value = copyRange.Value
    Set copyRange = foundCell.Offset(0, 26)
    cellX.Offset(0, 26).Value = copyRange.Value
    Set copyRange = foundCell.Offset(0, 27)
    cellX.Offset(0, 27).Value = copyRange.Value
    End If
  
  Next cellX
  Next wsY
 'wbX.Close
  wbY.Close
 End Sub

Maybe try to put all the path and file name in a sheet (say in sheet3 cell A2:A10). Then loop to each cell to open the wb one by one, do the checking, then close the wb, then open the next wb. Something like : `for each cell in sheet3.range("A2:A10")` ... `Set wbY = Workbooks.Open(cell.value)` --> the wb open. Then loop into the sheet of this opened wb `For Each wsY In wbY.Sheets` and so on. For the block inside `If Not foundCell Is Nothing Then` I think maybe you can make it shorter, something like : `cellX.Offset(0, 1).resize(1,27).Value = foundCell.Offset(0, 1).resize(1,27).Value` — karma, Apr 24 '23 at 21:42
@Karma - I tried this but the additional "For each" command causes the code to error as it needs another "Next" statement. In the end I got pissed off with it, wrote the original code specific to one workbook, then duplicated the code fir each other individual workbook, and used "Call" commands on a master macro to run them all sequentially. Really ugly inelegant solution but does at least work. I'm still very receptive to anyone who has a more elegant solution. — Rob E, May 01 '23 at 08:58

How do I write VBA code which searches multiple sheets on multiple workbooks for cell values, then returns all offset row data

0 Answers0