Search code examples
excelvbaexcel-2019

Loop Through All Sheets in Workbook, Compare Two Sets of Cells, Copy Another Cell Value


I have a workbook with 50+ sheets. On all but the last of these sheets, A19:L30 is the range I'm concerned with. Within each row in this range, cell Kx is a job code, Lx is a sub-code for the given job, and Jx is the total hours worked in a specific time period that were charged to that specific job code/sub code combination.

On the last sheet, I have all possible job code/sub code combinations listed in three columns, following the same format as the data on the other sheets. Ax is grand total hours charged to a given code combination, Bx is the job code, and Cx is the work code. What I'm trying to do is loop through all sheets in the workbook and compare Kx and Lx in the sheet being searched with Ax and Bx, respectively, in the last sheet, and if the codes match then add that row's totals to the grand total on the last sheet.

What I have so far:

Sub GetAllJobCodes()
Dim ws As Worksheet
Dim x As Integer
Dim z As Integer
Dim NumOfTotals As Integer
NumOfTotals = (JobCodesSorted.Count * WorkCodes.Count) + 1

Dim Totals(500) As Double

Dim TotalsTemp As Double

For x = 1 To NumOfTotals - 1

    Totals(x) = 0

Next

For x = 2 To 53
    For Each ws In ActiveWorkbook.Worksheets
        For z = 19 To 30
            If ws.Cells(z, 11) = Sheets("Job Totals").Cells(x, 2) And ws.Cells(z, 12) = Sheets("Job Totals").Cells(x, 3) Then
                TotalsTemp = CDbl(Row.Cells(z, 10))
                Totals(x) = Totals(x) + TotalsTemp
            End If
            
        Next z

    Next ws
Next x

For x = 2 To NumOfTotals

    Sheets("Job Totals").Cells(x, 1) = Totals(x)

Next

End Sub

JobCodesSorted and WorkCodes are defined further upstream. Running this code assigns NumOfTotals a value of 71. I run this code, and all totals in the final sheet populate as zero. Change the last For loop to Debug.Print rather than print to cells, and all array values print as zeroes. Am I missing something? Any help is appreciated.


Solution

  • A VBA Lookup (Triple Nested Loops)

    • I found this mistake:

      TotalsTemp = CDbl(Row.Cells(z, 10))
      

      Why this isn't a compile error is a mystery to me.
      Maybe TotalsTemp = CDbl(ws.Cells(z, 10)) is the only change needed.

    • Since you figured that we don't need to see the screenshots of your data and the code before this code, I could come up only with this.

    • It's still as slow as before and it still has many magic numbers but it might bring you on the right track.

    The Code

    Sub GetAllJobCodes()
        
        Dim wb As Workbook: Set wb = ActiveWorkbook
        ' If the worksheets are in the workbook containing this code, use:
        'Dim wb As Workbook: Set wb = ThisWorkbook
        
        Dim dws As Worksheet: Set dws = wb.Worksheets("Job Totals")
        
        Dim Totals(2 To 53, 1 To 1) As Double
        
        Dim sws As Worksheet
        Dim sr As Long
        Dim dr As Long
        Dim TotalsTemp As Double
        
        For Each sws In wb.Worksheets
            If Not sws Is dws Then ' exclude the destination worksheet
                For dr = 2 To 53
                    For sr = 19 To 30
                        If sws.Cells(sr, "K").Value = dws.Cells(dr, "B").Value And _
                            sws.Cells(sr, "L").Value = dws.Cells(dr, "C").Value _
                                Then
                            TotalsTemp = CDbl(sws.Cells(sr, "J").Value)
                            Totals(dr, 1) = Totals(dr, 1) + TotalsTemp
                        'Else ' no equality; do nothing
                        End If
                    Next sr
                Next dr
            'Else ' it's the destination worksheet; do nothing
            End If
        Next sws
        
        Dim drCount As Long: drCount = UBound(Totals, 1) - LBound(Totals, 1) + 1
        dws.Cells(2, "A").Resize(drCount).Value = Totals
        ' Or without 'drCount':
        'dws.Range("A2:A53").Value = Totals
        
    End Sub