4
\$\begingroup\$

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
\$\endgroup\$
8
  • 2
    \$\begingroup\$ 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. \$\endgroup\$
    – HackSlash
    Jul 9 at 16:43
  • \$\begingroup\$ 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. \$\endgroup\$
    – HackSlash
    Jul 9 at 16:47
  • \$\begingroup\$ @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. \$\endgroup\$ Jul 9 at 18:36
  • 1
    \$\begingroup\$ @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. \$\endgroup\$
    – HackSlash
    Jul 9 at 18:42
  • 1
    \$\begingroup\$ @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." \$\endgroup\$ Jul 9 at 20:28
1
\$\begingroup\$

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
\$\endgroup\$
2
  • \$\begingroup\$ 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? \$\endgroup\$ Jul 10 at 16:00
  • \$\begingroup\$ 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. \$\endgroup\$ Jul 10 at 16:13
4
\$\begingroup\$

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
\$\endgroup\$
3
  • \$\begingroup\$ 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? \$\endgroup\$ Jul 10 at 15:38
  • \$\begingroup\$ I tested this and it ran easily twice as fast as my loops. Thanks for you help. \$\endgroup\$ Jul 10 at 16:10
  • 1
    \$\begingroup\$ @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. \$\endgroup\$ Jul 10 at 16:18
2
\$\begingroup\$

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.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.