VBA code for summing values of multiple categories in same column

F

FrenchCelt

Board Regular
Joined
May 22, 2018
Messages
214
Office Version
  1. 365
Platform
  1. Windows
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.
 
Sort by date Sort by votes
mumps said:
Try this macro. I have added a prompt for you to enter the desired job function.
Code: 
Sub SumCells()
    Application.ScreenUpdating = False
    Dim LastRow As Long, response As String
    response = InputBox("Enter the job function.")
    If response = "" Then
        MsgBox ("You have not entered a job function.")
        Application.ScreenUpdating = True
        Exit Sub
    End If
    If WorksheetFunction.CountIf(Range("D:D"), response) = 0 Then
        MsgBox ("The job function entered was not found.  Please try again.")
        Application.ScreenUpdating = True
        Exit Sub
    End If
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("A1:J" & LastRow).AutoFilter Field:=2, Criteria1:=">" & Date - 45
    Range("A1:J" & LastRow).AutoFilter Field:=4, Criteria1:=response
    Range("M49") = WorksheetFunction.Sum(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible))
    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:=response
    Range("M426") = WorksheetFunction.Sum(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible))
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub
Click to expand...

I get "Run-time error '1004': No cells were found" for this bit:

Code: 
Range("M49") = WorksheetFunction.Sum(Range("E2:E" & LastRow1).SpecialCells(xlCellTypeVisible))
 
Upvote 0

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
mumps said:
Try this macro. I have added a prompt for you to enter the desired job function.
Code: 
Sub SumCells()
    Application.ScreenUpdating = False
    Dim LastRow As Long, response As String
    response = InputBox("Enter the job function.")
    If response = "" Then
        MsgBox ("You have not entered a job function.")
        Application.ScreenUpdating = True
        Exit Sub
    End If
    If WorksheetFunction.CountIf(Range("D:D"), response) = 0 Then
        MsgBox ("The job function entered was not found.  Please try again.")
        Application.ScreenUpdating = True
        Exit Sub
    End If
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("A1:J" & LastRow).AutoFilter Field:=2, Criteria1:=">" & Date - 45
    Range("A1:J" & LastRow).AutoFilter Field:=4, Criteria1:=response
    Range("M49") = WorksheetFunction.Sum(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible))
    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:=response
    Range("M426") = WorksheetFunction.Sum(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible))
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub
Click to expand...

Upon closer inspection, this is because there were no results in the autofilter for date range of 45 days or less for RECEIVE PALLET. I guess I need it to enter 0 if that's the case.
 
Upvote 0
Try this version. It will check the results of the autofilter before trying to return a value to M26 and M49.
Code: 
Sub SumCells()
    Application.ScreenUpdating = False
    Dim LastRow As Long, response As String
    response = InputBox("Enter the job function.")
    If response = "" Then
        MsgBox ("You have not entered a job function.")
        Application.ScreenUpdating = True
        Exit Sub
    End If
    If WorksheetFunction.CountIf(Range("D:D"), response) = 0 Then
        MsgBox ("The job function entered was not found.  Please try again.")
        Application.ScreenUpdating = True
        Exit Sub
    End If
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("A1:J" & LastRow).AutoFilter Field:=2, Criteria1:=">" & Date - 45
    Range("A1:J" & LastRow).AutoFilter Field:=4, Criteria1:=response
    If WorksheetFunction.CountA(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible)) > 0 Then
        Range("M49") = WorksheetFunction.Sum(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible))
    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:=response
    If WorksheetFunction.CountA(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible)) > 0 Then
        Range("M26") = WorksheetFunction.Sum(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible))
    End If
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
mumps said:
Try this version. It will check the results of the autofilter before trying to return a value to M26 and M49.
Code: 
Sub SumCells()
    Application.ScreenUpdating = False
    Dim LastRow As Long, response As String
    response = InputBox("Enter the job function.")
    If response = "" Then
        MsgBox ("You have not entered a job function.")
        Application.ScreenUpdating = True
        Exit Sub
    End If
    If WorksheetFunction.CountIf(Range("D:D"), response) = 0 Then
        MsgBox ("The job function entered was not found.  Please try again.")
        Application.ScreenUpdating = True
        Exit Sub
    End If
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("A1:J" & LastRow).AutoFilter Field:=2, Criteria1:=">" & Date - 45
    Range("A1:J" & LastRow).AutoFilter Field:=4, Criteria1:=response
    If WorksheetFunction.CountA(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible)) > 0 Then
        Range("M49") = WorksheetFunction.Sum(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible))
    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:=response
    If WorksheetFunction.CountA(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible)) > 0 Then
        Range("M26") = WorksheetFunction.Sum(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible))
    End If
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub
Click to expand...

Same result, no cells were found.
 
Upvote 0
mumps said:
Try this version. It will check the results of the autofilter before trying to return a value to M26 and M49.
Code: 
Sub SumCells()
    Application.ScreenUpdating = False
    Dim LastRow As Long, response As String
    response = InputBox("Enter the job function.")
    If response = "" Then
        MsgBox ("You have not entered a job function.")
        Application.ScreenUpdating = True
        Exit Sub
    End If
    If WorksheetFunction.CountIf(Range("D:D"), response) = 0 Then
        MsgBox ("The job function entered was not found.  Please try again.")
        Application.ScreenUpdating = True
        Exit Sub
    End If
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("A1:J" & LastRow).AutoFilter Field:=2, Criteria1:=">" & Date - 45
    Range("A1:J" & LastRow).AutoFilter Field:=4, Criteria1:=response
    If WorksheetFunction.CountA(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible)) > 0 Then
        Range("M49") = WorksheetFunction.Sum(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible))
    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:=response
    If WorksheetFunction.CountA(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible)) > 0 Then
        Range("M26") = WorksheetFunction.Sum(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible))
    End If
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub
Click to expand...

I did try it with one of the other job function categories (PICKING RACK NON) and it did produce results for both new hires and tenured employees, so the code is working in principle.
 
Upvote 0
Try:
Code: 
Sub SumCells()
    Application.ScreenUpdating = False
    Dim LastRow As Long, response As String
    response = InputBox("Enter the job function.")
    If response = "" Then
        MsgBox ("You have not entered a job function.")
        Application.ScreenUpdating = True
        Exit Sub
    End If
    If WorksheetFunction.CountIf(Range("D:D"), response) = 0 Then
        MsgBox ("The job function entered was not found.  Please try again.")
        Application.ScreenUpdating = True
        Exit Sub
    End If
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("A1:J" & LastRow).AutoFilter Field:=2, Criteria1:=">" & Date - 45
    Range("A1:J" & LastRow).AutoFilter Field:=4, Criteria1:=response
    If Range("A2", Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row = 1 Then
        MsgBox ("There are no " & response & " job functions for new hires.")
    Else
        If WorksheetFunction.CountA(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible)) > 0 Then
            Range("M49") = 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:=response
    If Range("A2", Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row = 1 Then
        MsgBox ("There are no " & response & " job functions for tenured employees.")
    Else
        If WorksheetFunction.CountA(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible)) > 0 Then
            Range("M26") = WorksheetFunction.Sum(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible))
        End If
    End If
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
mumps said:
Try:
Code: 
Sub SumCells()
    Application.ScreenUpdating = False
    Dim LastRow As Long, response As String
    response = InputBox("Enter the job function.")
    If response = "" Then
        MsgBox ("You have not entered a job function.")
        Application.ScreenUpdating = True
        Exit Sub
    End If
    If WorksheetFunction.CountIf(Range("D:D"), response) = 0 Then
        MsgBox ("The job function entered was not found.  Please try again.")
        Application.ScreenUpdating = True
        Exit Sub
    End If
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("A1:J" & LastRow).AutoFilter Field:=2, Criteria1:=">" & Date - 45
    Range("A1:J" & LastRow).AutoFilter Field:=4, Criteria1:=response
    If Range("A2", Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row = 1 Then
        MsgBox ("There are no " & response & " job functions for new hires.")
    Else
        If WorksheetFunction.CountA(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible)) > 0 Then
            Range("M49") = 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:=response
    If Range("A2", Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row = 1 Then
        MsgBox ("There are no " & response & " job functions for tenured employees.")
    Else
        If WorksheetFunction.CountA(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible)) > 0 Then
            Range("M26") = WorksheetFunction.Sum(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible))
        End If
    End If
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub
Click to expand...

Ok, that worked! It filled in the quantity completed for tenured employees and left blank the cell for new hires, since no new hires performed the receive pallet job function. So I can use this as a template to flesh out all the other job functions by date of hire to complete my weekly report, but is there a way to eliminate the message box element and have it autofill the cells directly for the job function? If not, this will still be a HUGE time saver, cutting the job down from over an hour to a few minutes, and I'll take that and be grateful.
 
Upvote 0
The message box can be eliminated but how do you decide which job function to sort by?
 
Upvote 0
mumps said:
The message box can be eliminated but how do you decide which job function to sort by?
Click to expand...

I run the code to sort by date of hire for one job function, then copy/paste below with the next job function, adjusting the cell placement for the sum values, and so on until all of them have been completed. That's how I got the base code you originally gave me to do all of the job function sums for all employees.
 
Upvote 0
mumps said:
The message box can be eliminated but how do you decide which job function to sort by?
Click to expand...

I think I may have figured it out on my own. I did some blending of code from what you gave me and so far it's working. I'll let you know if I run into any complications. Otherwise, thanks for all your help! You're a real lifesaver.:biggrin:
 
Upvote 0
You must log in or register to reply here.

Similar threads

W
  • Question
Sum value in a column based on condition
Replies
1
Views
127
SunnyAlv
SunnyAlv
E
  • Question
Sumifs, Index, formula only summing first value
Replies
1
Views
417
etaf
etaf
C
  • Question
SUM based on same value across multiple columns
Replies
3
Views
99
awoohaw
awoohaw
Agnarr
  • Question
VBA problem with creating new sheets
Replies
0
Views
482
Agnarr
Agnarr
B
  • Solved
Returning entire rows from multiple sheets into array based on lookup values in multiple columns
Replies
1
Views
522
KRice
K

Forum statistics

Threads
1,216,577
Messages
6,131,511
Members
449,653
Latest member
andz

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top