Collating data from multiple Non-uniform sheets and workbooks using VBA

In this article, we will collate the total sales data from Excel sheets that have different number of rows and different number and order of column headers. For Example

The google drive path contains the input Excel sheets. We need to calculate the total sales for each Item (all months combined). We will use the HLOOKUP Formula. We can manually apply HLOOKUP and add the sheet-level sums to get the Total. But when more than 50 sheets in 10 different workbooks are involved, this is a tedious, time-consuming and error-prone process. We can apply HLOOKUP through VB, and this can be scaled up to handle even hundreds of worksheets in different workbooks.

To create a macro, open a new Excel and save it as Sales Macro.xlsm. We can insert a Command Button into the Macro sheet

To enable development mode, go to File-> Options-> Customize Ribbon-> Check “Developer” Tab

To trigger the VB Script using a button. In the Developer tab, Drag and drop the Command Button(ActiveX Control) using the Insert option. 

Drag and drop Command Button to the spreadsheet and double-click to open the VB Editor. 

The code in the Sub will be executed on click of the command button. Place the downloaded workbooks in a single folder(D:\Sales Data). We can enter the folder path into the Macro in Cell H5 (5,8). The VB can read the path and append “/” to it. 

    Dim folderPath
    folderPath = Application.ThisWorkbook.Worksheets("Sheet1").Cells(5, 8).Value

    folderPath = folderPath & "\"

Let us first look at the process of Finding the total sales for a single Sheet(March). To get the details for Item F from Workbook “Sales data Q1 2019.xlsx” and Sheet for “March”, we should first put the sum of sales values into the last row, and then use the HLOOKUP Function.

Sum of Sales of Item F for March

=HLOOKUP("Item F",'[Sales data Q1 2019.xlsx]March'!$B$1:$D$7,7,FALSE)

The number of rows and columns change for each sheet. So D should be replaced with the last Column letter and 7 should be replaced with the last row number. To open the workbook Sales data Q1 2019.xlsx, we use

Set salesWorkbook = Workbooks.Open(folderPath & "Sales data Q1 2019.xlsx")

The following statements are written inside  With salesWorkbook.Worksheets("March") .We have to first set the sum formula to the line after last row. To find the last row, we can use 

lastRow = .Cells(Rows.Count, "A").End(xlUp).Row

To set the sum formula after the last cell in Column B, we use

.Range("B" & CStr(lastRow + 1)).Formula = "=SUM(B2:B" & CStr(lastRow) & ")"

To get the last column number, 

 lastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column

We can get the last column letter by splitting the address by “$”. (Eg. From Address $D$1) 

 lastColumnLetter = Split(.Cells(1, lastColumn).Address, "$")(1)

To drag the Formula from B:”lastRow+1” to “lastLetterColumn”:”lastRow+1”, use .Range.FillRight 

.Range("B" & CStr(lastRow + 1) & ":" & lastColumnLetter & CStr(lastRow + 1)).FillRight

Replacing $D and $7 the above HLOOKUP formula with $lastColumnLetter and $(lastRow+1) respectively, we have 

hlookupFormula = "HLOOKUP($H$6,'[Sales data Q1 2019.xlsx]March'!$B$1:$" &  lastColumnLetter & "$" & CStr(lastRow+1) & "," & CStr(lastRow+1) &  ",FALSE)"

If we get the Item name from a cell(H6) in the Macro, we can replace “Item F” with $H$6. If “Item F” does not exist in the column headings, the HLOOKUP formula will return a #N/A error. We can use the Excel ISERROR Formula to return 0 in case there is an error.

formulaValue = "=IF(ISERROR(" & hlookupFormula & "),0," & hlookupFormula & ")"

The above formula returns 0 if the Item does not exist in Sheet March and the sum of sales for Item with name $H$6 if the name exists in the headings. 

To find the sum at a workbook level, we need to iterate through each sheet in the workbook and add all the Sheet-level HLOOKUP formulae

formulaValue = ""
For Each sht In salesWorkbook.Worksheets
  With sht
    lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
    .Range("B" & CStr(lastRow + 1)).formula = "=SUM(B2:B" & CStr(lastRow) & ")"
    lastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column
    lastColumnLetter = Split(.Cells(1, lastColumn).Address, "$")(1)
    .Range("B" & CStr(lastRow + 1) & ":" & lastColumnLetter & CStr(lastRow + 1)).FillRight
  End With
  hlookupFormula = "HLOOKUP($H$6,'[Sales data Q1 2019.xlsx]" & sht.Name & "'!$B$1:$" & lastColumnLetter & "$" & CStr(lastRow + 1) & "," & CStr(lastRow + 1) & ",FALSE)"
  If formulaValue = "" Then
    formulaValue = "=IF(ISERROR(" & hlookupFormula & "),0," & hlookupFormula & ")"
  Else
    formulaValue = formulaValue & "+IF(ISERROR(" & hlookupFormula & "),0," & hlookupFormula & ")"
  End If

Next

To remove the hard-coding of Workbook name, we need to iterate over all Excel files in the folderPath. To do this, we can use 

Dim StrFile As String
  StrFile = Dir(folderPath & "\*.xlsx")
  Do While Len(StrFile) > 0
      Set salesWorkbook = Workbooks.Open(folderPath & StrFile)
    'Add the formula  of each sheet in salesWorkBook to formulaValue
    'Similar to what was done sheet wise
    StrFile = Dir
  Loop 

  The HLOOKUP formula should be replaced with

hlookupFormula = "HLOOKUP($H$6,'[" & StrFile & "]" & sht.Name & "'!$B$1:$" & lastColumnLetter & "$" & CStr(lastRow + 1) & "," & CStr(lastRow + 1) & ",FALSE)"

Please find the macro here. Please find the full code below. Let me know if any difficulties.

Private Sub CommandButton1_Click()
  Dim folderPath, lastRow, lastColumn, lastColumnLetter, formulaValue, hlookupFormula, StrFile As String
  Dim salesWorkbook As Workbook
  Dim currentWorkSheet As Worksheet
  Set currentWorkSheet = Application.ThisWorkbook.Worksheets("Sheet1")
  folderPath = currentWorkSheet.Cells(5, 8).Value
  folderPath = folderPath & "\"
  formulaValue = ""
  StrFile = Dir(folderPath & "\*.xlsx")
  Do While Len(StrFile) > 0
    Set salesWorkbook = Workbooks.Open(folderPath & StrFile)
    For Each sht In salesWorkbook.Worksheets
      With sht
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        .Range("B" & CStr(lastRow + 1)).formula = "=SUM(B2:B" & CStr(lastRow) & ")"
        lastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column
        lastColumnLetter = Split(.Cells(1, lastColumn).Address, "$")(1)
        .Range("B" & CStr(lastRow + 1) & ":" & lastColumnLetter & CStr(lastRow + 1)).FillRight
      End With
      hlookupFormula = "HLOOKUP($H$6,'[" & StrFile & "]" & sht.Name & "'!$B$1:$" & lastColumnLetter & "$" & CStr(lastRow + 1) & "," & CStr(lastRow + 1) & ",FALSE)"
      If formulaValue = "" Then
        formulaValue = "=IF(ISERROR(" & hlookupFormula & "),0," & hlookupFormula & ")"
      Else
        formulaValue = formulaValue & "+IF(ISERROR(" & hlookupFormula & "),0," & hlookupFormula & ")"
      End If
    Next
    StrFile = Dir
  Loop
  currentWorkSheet.Range("H7").Value = formulaValue
End Sub