Excel Forum

Code: Select all

Sub CalculateSums()
    Dim wsWL As Worksheet
    Dim wsSUM As Worksheet
    Dim lastRow As Long
    Dim dateCell As Range
    Dim dateVal As Integer
    Dim colHeaders As Range
    Dim sumHeaders As Range
    Dim headerMatch As Range
    Dim i As Long, j As Long
    Dim cellValue As Double
    
    Set wsWL = ThisWorkbook.Sheets("W-L")
    Set wsSUM = ThisWorkbook.Sheets("SUM")
    
    
    lastRow = wsWL.Cells(wsWL.Rows.Count, "I").End(xlUp).Row
    
    
    Set colHeaders = wsWL.Range("J1:CP1")
    Set sumHeaders = wsSUM.Range("C1:CI1")
    
    
    wsSUM.Range("C3:CI3").Value = 0
    wsSUM.Range("C6:CI6").Value = 0
    wsSUM.Range("C9:CI9").Value = 0
    wsSUM.Range("C12:CI12").Value = 0

    For i = 2 To lastRow
        
        Set dateCell = wsWL.Cells(i, "I")
        If IsDate(dateCell.Value) Then
            dateVal = Day(dateCell.Value)
            
            
            If dateVal >= 1 And dateVal <= 7 Then
                Set sumRange = wsSUM.Range("C3:CI3")
            ElseIf dateVal >= 8 And dateVal <= 14 Then
                Set sumRange = wsSUM.Range("C6:CI6")
            ElseIf dateVal >= 15 And dateVal <= 21 Then
                Set sumRange = wsSUM.Range("C9:CI9")
            ElseIf dateVal >= 22 And dateVal <= 31 Then
                Set sumRange = wsSUM.Range("C12:CI12")
            Else
                GoTo NextRow
            End If
            
        
            For j = 1 To colHeaders.Columns.Count
                
                Set headerMatch = sumHeaders.Find(what:=colHeaders.Cells(1, j).Value, LookIn:=xlValues, lookat:=xlWhole)
                
                If Not headerMatch Is Nothing Then
                    
                    If IsNumeric(wsWL.Cells(i, j + 9).Value) Then
                        cellValue = wsWL.Cells(i, j + 9).Value
                    Else
                        cellValue = 0
                    End If
                    
                    
                    sumRange.Cells(1, headerMatch.Column - 2).Value = sumRange.Cells(1, headerMatch.Column - 2).Value + cellValue
                End If
            Next j
        End If
        
NextRow:
    Next i
    
    MsgBox "Calculation complete!"
End Sub

Code: Select all

'Other code...
            If dateVal >= Sheet1.[c20] And dateVal <= Sheet1.[d20] Then
                Set sumRange = wsSUM.Range("C3:CI3")
            ElseIf dateVal >= Sheet1.[c21] And dateVal <= Sheet1.[d21] Then
                Set sumRange = wsSUM.Range("C6:CI6")
            ElseIf dateVal >= Sheet1.[c22] And dateVal <= Sheet1.[d22] Then
                Set sumRange = wsSUM.Range("C9:CI9")
            ElseIf dateVal >= Sheet1.[c23] And dateVal <= Sheet1.[d23] Then
                Set sumRange = wsSUM.Range("C12:CI12")
            Else
                GoTo NextRow
            End If
'Other code...