Generating a bill of materials in Excel VBA

Question

I am not an advanced user of Excel and am VERY new to VBA. My only programming experience is 2 C# classes in college. That being said, go easy on me ;)

I am working on a team that audits military bases for energy conservation projects. I am trying to revise a workbook that is currently used to document HVAC equipment in all the buildings on the base. Each building has a separate sheet named after the building number. Each sheet uses the same table and format.

My biggest hurdle was creating a Bill of Materials page that would go through each sheet and count all the parts needed to order. Each sheet can have any combination of parts and quantities so I figured the best way was to loop through each item on a master list and count all the instances in each sheet. As such I have ended up with several nested loops which takes a while to run with a test of only 9 sheets. The code works which is most important to me, but I'm hooked now and want to learn how to make it better. I have picked up a book on VBA and plan on looking into arrays and how they might help. I just wanted to see if anyone could give me some pointers based on what I have now.

 Private Sub GenerateBOM_Click()
'generating a bill of materials with data from templated tables on separate sheets. Part order and quantity can change on each sheet. Sheets are named after
'building numbers which could include letters so couldn't find a better way of excluding the summary and data sheets. Wanted to allow for slight table
'structure changes so attempted to locate everything by names.
 Dim ws As Worksheet
 Dim tbl As ListObject
 Dim wsBOM As Worksheet
 Dim tblBOM As ListObject
 Dim row As range
 Dim searchRow As range
 Dim rowCount As Long
 Dim partCount As Long
 Dim totalCount As Long
 Dim partQty As Long
 
 Set wsBOM = Worksheets("Bill of Materials")
 Set tblBOM = wsBOM.ListObjects("BOM")
 Application.ScreenUpdating = False
 
 For Each row In tblBOM.ListColumns("Part Number").DataBodyRange.Rows
 rowCount = row.row - tblBOM.HeaderRowRange.row 'getting index of the row being searched. Tried to use ListRow but couldn't figure it out with the overall search
 totalCount = 0
 
 For Each ws In ThisWorkbook.Worksheets 'Loop through all sheets in a workbook
 
 If ws.Name <> "Cover" And ws.Name <> "Building List" And ws.Name <> "Data" And ws.Name <> "Building Template" And ws.Name <> "Parts" And ws.Name <> "Bill of Materials" Then
 
 For Each tbl In ws.ListObjects 'Loop through all table on a sheet
 
 For Each searchRow In tbl.ListColumns("Part Number").DataBodyRange.Rows 'Loop through all part number rows on table
 partQty = 0
 partQty = tbl.ListColumns("Qty").DataBodyRange(searchRow.row - tbl.HeaderRowRange.row) 'getting index of the row being searched to find per sheet part qty
 partCount = (Application.WorksheetFunction.CountIf(searchRow, row) * partQty)
 totalCount = totalCount + partCount
 tblBOM.ListColumns("Project Totals").DataBodyRange.Cells(rowCount).Value = totalCount 'writing total to bill of materials sheet at index of searched part number
 
 Next searchRow
 Next tbl
 End If
 Next ws
 Next row
 Application.ScreenUpdating = True
End Sub

• HackSlash: Don't use the name row for a variable as that is the name of a property you are using. This is what forces the row in tblBOM.HeaderRowRange.row to be lower case. It also leads to the confusing statement row.row.
• HackSlash: It might be better to calculate some of these values with formulas in the worksheets themselves instead of in VBA. Tables have a total row feature that can automatically collect some information for you.
• Sᴀᴍ Onᴇᴌᴀ: @HackSlash Please add an answer instead of a comment. Refer to the section When shouldn't I comment? on Comment everywhere, and note that short answers are acceptable.
• HackSlash: @SᴀᴍOnᴇᴌᴀ, most people don't appreciate the answer being to use a different technology. In this case, where the solution could be written entirely in formulas, I feel like that would go against the spirit of Code Review. It's still helpful advice and thus only a comment. If Jason runs in to a situation where VBA is required along the way, he could use a UDF and still completely avoid having to press a button to calculate the BOM. It would just be updated live and always correct.
• Sᴀᴍ Onᴇᴌᴀ: @HackSlash a single item would be "one insightful observation"- From How do I write a good answer?: "Every answer must make at least one insightful observation about the code in the question....Answers need not cover every issue in every line of the code. Short answers are acceptable, as long as you explain your reasoning. Do not provide suggestions for improvements in a comment, even if your suggestion makes a very short answer."

Answer 1

VBA SumIf in Columns of Multiple Tables

Option Explicit
Sub GenerateBOM()
 
 Const dName As String = "Bill of Materials"
 Const dtblName As String = "BOM"
 Const dlName As String = "Part Number"
 Const drName As String = "Project Totals"
 
 Const slName As String = "Part Number"
 Const srName As String = "Qty"
 
 Const ExceptionsList As String _
 = "Cover,Building List,Data,Building Template,Parts,Bill of Materials"
 
 Dim wb As Workbook: Set wb = ThisWorkbook
 
 ' Write the names of the worksheets to be 'processed' to an array.
 Dim swsNames As Variant ' Source Worksheet Names Array
 swsNames = ArrWorksheetNames(wb, ExceptionsList)
 If IsEmpty(swsNames) Then Exit Sub
 
 ' Write the values from the Destination Lookup Range to the Data Array.
 Dim dws As Worksheet ' Destination Worksheet
 Set dws = wb.Worksheets(dName)
 Dim dtbl As ListObject ' Destination Table
 Set dtbl = dws.ListObjects(dtblName)
 Dim dlrg As Range ' Destination Lookup Column Range
 Set dlrg = dtbl.ListColumns(dlName).DataBodyRange
 Dim Data As Variant ' Data Array
 Data = GetColumnRange(dlrg)
 
 Dim sws As Worksheet ' Source Worksheet
 Dim stbl As ListObject ' Source Table
 Dim slrg As Range ' Source Lookup Column Range
 Dim ssrg As Range ' Source Sum Column Range
 
 Dim r As Long ' Data Array Row Counter
 Dim PartCount As Long ' Part Counter
 Dim TotalCount As Long ' Total Counter
 
 ' The Loops
 ' The same array is used for the 'lookups' and the results (totals).
 For r = 1 To UBound(Data, 1)
 TotalCount = 0
 For Each sws In wb.Worksheets(swsNames)
 For Each stbl In sws.ListObjects
 Set slrg = stbl.ListColumns(slName).DataBodyRange
 Set ssrg = stbl.ListColumns(srName).DataBodyRange
 PartCount = Application.SumIf(slrg, Data(r, 1), ssrg)
 TotalCount = TotalCount + PartCount
 Next stbl
 Next sws
 Data(r, 1) = TotalCount
 Next r
 
 ' Write the values from the Data Array
 ' to the Destination Result Column Range.
 Dim drrg As Range ' Destination Result Column Range
 Set drrg = dtbl.ListColumns(drName).DataBodyRange
 drrg.Value = Data
 
 MsgBox "BOM succesfully generated.", vbInformation, "Generate BOM"
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns the names of the worksheets of a workbook,
' that are not listed, in a 1D one-based array.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ArrWorksheetNames( _
 ByVal wb As Workbook, _
 Optional ByVal ExceptionsList As String = "", _
 Optional ByVal ListDelimiter As String = ",") _
As Variant
 
 If wb Is Nothing Then Exit Function
 
 Dim wsCount As Long: wsCount = wb.Worksheets.Count
 If wsCount = 0 Then Exit Function ' no worksheet
 
 Dim Arr() As String: ReDim Arr(1 To wsCount)
 
 Dim sws As Worksheet
 Dim n As Long
 
 If Len(ExceptionsList) = 0 Then
 
 For Each sws In wb.Worksheets
 n = n + 1
 Arr(n) = sws.Name
 Next sws
 
 Else
 
 Dim Exceptions() As String
 Exceptions = Split(ExceptionsList, ListDelimiter)
 
 Dim wsName As String
 
 For Each sws In wb.Worksheets
 wsName = sws.Name
 If IsError(Application.Match(wsName, Exceptions, 0)) Then
 n = n + 1
 Arr(n) = wsName
 End If
 Next sws
 
 If n = 0 Then Exit Function ' no worksheet that's not in the list
 
 If n < wsCount Then
 ReDim Preserve Arr(1 To n)
 End If
 
 End If
 
 ArrWorksheetNames = Arr
 
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns the values of the first column of a range
' in a 2D one-based one-column array.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetColumnRange( _
 ByVal rg As Range) _
As Variant
 
 If rg Is Nothing Then Exit Function
 
 Dim cData As Variant
 With rg.Columns(1)
 Dim rCount As Long: rCount = rg.Rows.Count
 If rCount = 1 Then ' one cell
 ReDim cData(1 To 1, 1 To 1): cData(1, 1) = .Value
 Else
 cData = .Value ' multiple cells
 End If
 End With
 
 GetColumnRange = cData
End Function

• Jason Rosati: Thank you very much. This is a lot to digest. I have so much to learn. I am catching a flight to Japan tomorrow and will try to get my head wrapped around this code. Are functions similar to writing you own methods? I have picked up the book Microsoft Excel 2019 VBA and Macros by Bill Jelen. Do you have any recommendations for training material or online courses?
• Jason Rosati: I tested your code in my workbook and it was lighting fast. Thank you so much for your help. I have elevated arrays to the top of my list of things to study for multiple reasons. I just have a hard time visualizing the structures so it isn't obvious to me where they are advantageous.

Answer 2

Use descriptive variable names: When choosing variables names always avoid reserved words. Err on the side of verbosity. For example: Don't use the name row for a variable as that is the name of a property you are using. This is what forces the row in tblBOM.HeaderRowRange.row to be lower case. It also leads to the confusing statement row.row

Move declaration close to usage: I think it makes it easier to keep track of variables to declare them right before first use. This gets us away from the large variable block at the top, which can get difficult to manage.

Use an error handler to ensure your finalizing code runs: In this case I'm talking about ensuring that Application.ScreenUpdating = True always runs. You're going to have a bad time if you leave it off on accident.

Use a collection to only do your sheet filtering once: If we collect all the sheets we want to look at first we don't have to filter it each time through the loop.

Move your total count assignment out to the highest level it can go: You are setting the Project total for every iteration of the deepest level. I believe you only need to set it once.

Option Explicit
Private Sub GenerateBOM_Click()
 'generating a bill of materials with data from templated tables on separate sheets. Part order and quantity can change on each sheet. Sheets are named after
 'building numbers which could include letters so couldn't find a better way of excluding the summary and data sheets. Wanted to allow for slight table
 'structure changes so attempted to locate everything by names.
 On Error GoTo errorHandler
 Dim tblBOM As ListObject
 With ActiveWorkbook.Worksheets("Bill of Materials")
 Set tblBOM = .ListObjects("BOM")
 End With
 Application.ScreenUpdating = False
 Dim usedWorksheets As New Collection
 Dim ws As Worksheet
 For Each ws In ThisWorkbook.Worksheets
 If ws.Name <> "Cover" And ws.Name <> "Building List" And ws.Name <> "Data" And ws.Name <> "Building Template" And ws.Name <> "Parts" And ws.Name <> "Bill of Materials" Then
 usedWorksheets.Add ws
 End If
 Next ws
 Dim BOMpartRow As Range
 For Each BOMpartRow In tblBOM.ListColumns("Part Number").DataBodyRange.Rows
 Dim rowCount As Long
 rowCount = BOMpartRow.Row - tblBOM.HeaderRowRange.Row 'getting index of the row being searched. Tried to use ListRow but couldn't figure it out with the overall search
 
 Dim totalCount As Long
 totalCount = 0
 For Each ws In usedWorksheets 'Loop through all sheets in a workbook
 Dim tbl As ListObject
 For Each tbl In ws.ListObjects 'Loop through all table on a sheet
 Dim searchRow As Range
 For Each searchRow In tbl.ListColumns("Part Number").DataBodyRange.Rows 'Loop through all part number rows on table
 Dim partQty As Long
 partQty = tbl.ListColumns("Qty").DataBodyRange(searchRow.Row - tbl.HeaderRowRange.Row) 'getting index of the row being searched to find per sheet part qty
 Dim partCount As Long
 partCount = (Application.WorksheetFunction.CountIf(searchRow, BOMpartRow) * partQty)
 totalCount = totalCount + partCount
 Next searchRow
 Next tbl
 Next ws
 
 tblBOM.ListColumns("Project Totals").DataBodyRange.Cells(rowCount).Value = totalCount 'writing total to bill of materials sheet at index of searched part number
 Next BOMpartRow
errorHandler:
 Application.ScreenUpdating = True
End Sub

• Jason Rosati: I am not familiar with collections. I will add this to my study list. I also needed to look into error handling. I totally get what you are saying if the screen updating accidentally got left off. With the variable declarations being lower in the code, does this affect their scope? Does VBA even have variable scope?
• Jason Rosati: I tested this and it ran easily twice as fast as my loops. Thanks for you help.
• Mathieu Guindon: @Jason local variables can be declared anywhere in the body of a procedure scope, and they are usable anywhere after their declaration, even though Dim is not an executable statement; you can think of it as all Dim statements in a scope "executing" all at once as the scope is being entered, but the compiler will enforce (with Option Explicit, which should always be enabled) that a variable is declared before it is used. Scopes in VBA are global > module > procedure, there is no scope smaller than procedure scope in VBA.

Answer 3

I'm in agreement with the comments/answer provided by @HackSlash and have used the @HackSlash version of the Subroutine in this answer. And, the @VBasic2008 version certainly is an improvement as well and demonstrates a more efficient implementation while reducing the levels of nesting from 4 to 3. That said, the original title of the post implied a interest in alternatives to nested loops.

So...regarding the removal/reduction of nested loops:

To reduce nested levels, one strategy is to convert some or all loops into a function or subroutine with parameters based on the data/objects propagated from nesting level to nesting level. The result is code with a set of small support functions each dedicated to the achieving the goals of a nesting level. Generally, this results in improved readability and, if needed, can be tested independently.

In this case, the example below has refactored nearly all of the code into a new Standard Module GenerateBOMSupport. The code remaining in the original UserForm contains UI related concerns of handling the CommandButton click event and managing the Application.ScreenUpdating flag. This separation of concerns is consistent with the best practice of having only UI/control-related code in the UserForm code-behind.

 'UserForm code-behind
 Option Explicit
 Private Sub GenerateBOM_Click()
 'generating a bill of materials with data from templated tables on separate sheets. Part order and quantity can change on each sheet. Sheets are named after
 'building numbers which could include letters so couldn't find a better way of excluding the summary and data sheets. Wanted to allow for slight table
 'structure changes so attempted to locate everything by names.
 On Error GoTo errorHandler
 Application.ScreenUpdating = False
 
 Dim usedWorksheets As Collection
 Set usedWorksheets = GenerateBOMSupport.DetermineUsedWorksheets(ThisWorkbook)
 
 Dim bomWorksheet as Worksheet
 Set bomWorkSheet = ActiveWorkbook.Worksheets(GenerateBOMSupport.BOMWorksheetName)
 
 GenerateBOMSupport.UpdateBOMTotalCount bomWorkSheet, usedWorksheets
 
 errorHandler:
 Application.ScreenUpdating = True
 End Sub

And a supporting module. 'UpdateBOMTotalCount' has a single nested loop, otherwise nested loops have been refactored out.

 'Standard Module: GenerateBOMSupport 
 Option Explicit
 
 Public Const BOMWorksheetName As String = "Bill of Materials"
 Public Function DetermineUsedWorksheets(ByVal theWorkbook As Workbook) As Collection
 Set DetermineUsedWorksheets = New Collection
 
 Dim ws As Worksheet
 For Each ws In theWorkbook.Worksheets
 If ws.Name <> "Cover" And ws.Name <> "Building List" And ws.Name <> "Data" And ws.Name <> "Building Template" And ws.Name <> "Parts" And ws.Name <> "Bill of Materials" Then
 DetermineUsedWorksheets.Add ws
 End If
 Next ws
 End Function
 Public Sub UpdateBOMTotalCount(ByVal bomWorksheet As Worksheet, ByVal usedWorksheets As Collection)
 Dim tblBOM As ListObject
 Set tblBOM = bomWorksheet.ListObjects("BOM")
 Dim BOMpartRow As Range
 For Each BOMpartRow In tblBOM.ListColumns("Part Number").DataBodyRange.Rows
 Dim rowCount As Long
 rowCount = BOMpartRow.Row - tblBOM.HeaderRowRange.Row 'getting index of the row being searched. Tried to use ListRow but couldn't figure it out with the overall search
 
 Dim totalCount As Long
 totalCount = 0
 
 Dim ws As Worksheet
 For Each ws In usedWorksheets 'Loop through all sheets in a workbook
 totalCount = UpdateTotalCountFromWorksheet(ws, BOMpartRow, totalCount)
 Next ws
 
 tblBOM.ListColumns("Project Totals").DataBodyRange.Cells(rowCount).Value = totalCount 'writing total to bill of materials sheet at index of searched part number
 Next BOMpartRow
 End Sub
 Private Function UpdateTotalCountFromWorksheet(ws As Worksheet, ByVal BOMpartRow As Range, ByVal totalCount As Long) As Long
 
 UpdateTotalCountFromWorksheet = totalCount
 Dim tbl As ListObject
 For Each tbl In ws.ListObjects
 UpdateTotalCountFromWorksheet = UpdateTotalCountFromListObject(tbl, BOMpartRow, UpdateTotalCountFromWorksheet)
 Next tbl
 End Function
 Private Function UpdateTotalCountFromListObject(tbl As ListObject, ByVal BOMpartRow As Range, ByVal totalCount As Long) As Long
 UpdateTotalCountFromListObject = totalCount
 
 Dim searchRow As Range
 For Each searchRow In tbl.ListColumns("Part Number").DataBodyRange.Rows 'Loop through all part number rows on table
 Dim partQty As Long
 partQty = tbl.ListColumns("Qty").DataBodyRange(searchRow.Row - tbl.HeaderRowRange.Row) 'getting index of the row being searched to find per sheet part qty
 
 Dim partCount As Long
 partCount = (Application.WorksheetFunction.CountIf(searchRow, BOMpartRow) * partQty)
 
 UpdateTotalCountFromListObject = UpdateTotalCountFromListObject + partCount
 Next searchRow
 
 End Function

Granted, moving a nested loop to a dedicated function will not improve speed or efficiency. However, multiple-nested loops are more difficult to mentally parse and understand when it comes time to modify the code. Further, reducing nesting levels using functions forces the analysis of the data/objects communicated from nesting level to nesting level often making it easier to spot inefficiencies and other opportunities for improving the code.