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

Time:11-17

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.

CodePudding user response:

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
  • Related