VBA code for summing values of multiple categories in same column

[FrenchCelt]

Hello, I'm trying to build a macro that will sum the values from Column E based on multiple categories in Column D. Column D is comprised of various job functions (e.g. RECEIVE PALLET, CUTTER, and LETDOWN REACH) and Column E is comprised of the quantity completed for those job functions. In doing this manually, I filter by job function and sum the number of quantity completed for that function, but I would prefer to run a macro to do this for me. Does anyone have any suggestions? I figure all I need is a template for one of the job functions like RECEIVE PALLET and then I can customize for the rest of them.

 

[mumps]

See if this macro does what you want. It will calculate for all job functions.

Sub SumCells()
    With Application
         .Calculation = xlCalculationManual
         .ScreenUpdating = False
    End With
    Dim LastRow As Long
    LastRow = Sheets("cognos").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim x As Long: x = 26
    Dim rngUniques As Range, JF As Range
    Range("L26:M" & LastRow).ClearContents
    Range("D1:D" & LastRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("D1:D" & LastRow), Unique:=True
    Set rngUniques = Range("D2:D" & LastRow).SpecialCells(xlCellTypeVisible)
    If Sheets("cognos").FilterMode Then Sheets("cognos").ShowAllData
    For Each JF In rngUniques
        Range("A1:J" & LastRow).AutoFilter Field:=2, Criteria1:=">" & Date - 45
        Range("A1:J" & LastRow).AutoFilter Field:=4, Criteria1:=JF
        If Range("A2", Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row > 1 Then
            If WorksheetFunction.CountA(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible)) > 0 Then
                Range("L" & 25 + rngUniques.Count) = "New Hire"
                Range("L" & 26 + rngUniques.Count) = "Job Function"
                Range("M" & 26 + rngUniques.Count) = "Qty Complete"
                Cells(Rows.Count, "L").End(xlUp).Offset(1, 0) = JF
                Cells(Rows.Count, "M").End(xlUp).Offset(1, 0) = WorksheetFunction.Sum(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible))
            End If
        End If
        If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
        Range("A1:J" & LastRow).AutoFilter Field:=2, Criteria1:="<=" & Date - 45
        Range("A1:J" & LastRow).AutoFilter Field:=4, Criteria1:=JF
        If Range("A2", Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row > 1 Then
            If WorksheetFunction.CountA(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible)) > 0 Then
                Range("L" & x) = JF
                Range("M" & x) = WorksheetFunction.Sum(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible))
                x = x + 1
            End If
        End If
        If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    Next JF
    With Application
         .Calculation = xlCalculationAutomatic
         .ScreenUpdating = True
    End With
End Sub

 

[FrenchCelt]

See if this macro does what you want. It will calculate for all job functions.

Sub SumCells()
    With Application
         .Calculation = xlCalculationManual
         .ScreenUpdating = False
    End With
    Dim LastRow As Long
    LastRow = Sheets("cognos").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim x As Long: x = 26
    Dim rngUniques As Range, JF As Range
    Range("L26:M" & LastRow).ClearContents
    Range("D1:D" & LastRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("D1:D" & LastRow), Unique:=True
    Set rngUniques = Range("D2:D" & LastRow).SpecialCells(xlCellTypeVisible)
    If Sheets("cognos").FilterMode Then Sheets("cognos").ShowAllData
    For Each JF In rngUniques
        Range("A1:J" & LastRow).AutoFilter Field:=2, Criteria1:=">" & Date - 45
        Range("A1:J" & LastRow).AutoFilter Field:=4, Criteria1:=JF
        If Range("A2", Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row > 1 Then
            If WorksheetFunction.CountA(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible)) > 0 Then
                Range("L" & 25 + rngUniques.Count) = "New Hire"
                Range("L" & 26 + rngUniques.Count) = "Job Function"
                Range("M" & 26 + rngUniques.Count) = "Qty Complete"
                Cells(Rows.Count, "L").End(xlUp).Offset(1, 0) = JF
                Cells(Rows.Count, "M").End(xlUp).Offset(1, 0) = WorksheetFunction.Sum(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible))
            End If
        End If
        If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
        Range("A1:J" & LastRow).AutoFilter Field:=2, Criteria1:="<=" & Date - 45
        Range("A1:J" & LastRow).AutoFilter Field:=4, Criteria1:=JF
        If Range("A2", Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row > 1 Then
            If WorksheetFunction.CountA(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible)) > 0 Then
                Range("L" & x) = JF
                Range("M" & x) = WorksheetFunction.Sum(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible))
                x = x + 1
            End If
        End If
        If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    Next JF
    With Application
         .Calculation = xlCalculationAutomatic
         .ScreenUpdating = True
    End With
End Sub

Brilliant! Thanks!

 

[mumps]

My pleasure.