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]

Try:

Sub SumCells()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("D1:D" & LastRow).AutoFilter Field:=1, Criteria1:="CUTTER"
    Range("M7") = WorksheetFunction.Sum(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible))
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub

This macro is working for me on a dummy sheet. Can you post a screenshot of your data?

 

[FrenchCelt]

Try:

Sub SumCells()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("D1:D" & LastRow).AutoFilter Field:=1, Criteria1:="CUTTER"
    Range("M7") = WorksheetFunction.Sum(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible))
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub

This macro is working for me on a dummy sheet. Can you post a screenshot of your data?

How do I post screenshots?

 

[mumps]

Section B at this link has instructions on how to post a screen shot: https://www.mrexcel.com/forum/board-announcements/127080-guidelines-forum-use.html Alternately, you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do referring to specific cells and worksheets. If the workbook contains confidential information, you could replace it with generic data.

If you want to get total for all of the job functions, include a list of the job function names and in which cell you want to return the sum for each.

 

[FrenchCelt]

Try:

Sub SumCells()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("D1:D" & LastRow).AutoFilter Field:=1, Criteria1:="CUTTER"
    Range("M7") = WorksheetFunction.Sum(Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible))
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub

This macro is working for me on a dummy sheet. Can you post a screenshot of your data?

Never mind, I figured out what was causing the problem. I had inserted autofilter earlier into my code and this conflicted with the autofilter in your code. Once I removed the earlier autofilter, it worked perfectly. Thanks so much!

 

[mumps]

You are very welcome.

 

[FrenchCelt]

I have an additional wrinkle to this macro...the code I've added to sum the values of multiple categories in the same column worked great for giving me a combined sum for each category for all subjects, but now I also need to distinguish by date of hire. For this part, I want to sum all the job function categories for employees hired within the past 45 days and again for employees who have been working for over 45 days. So I've created additional sections to accommodate these stats, but how can I add the date dependency? As before, using CUTTER as the job function found in Column D with Quantity Complete in Column E, I also have Hire Date in Column B with the output cell being M26 for tenured employees (over 45 days) and M49 for new hires (under 45 days).

 

[mumps]

Please refer to Post#13 for instructions on how to upload a copy of your file. This will make it easier to test a possible solution.

 

[FrenchCelt]

Please refer to Post#13 for instructions on how to upload a copy of your file. This will make it easier to test a possible solution.

https://www.dropbox.com/s/vej51j0roco6gvu/Week 21 TM Throughput (Partial Macro).xlsx?dl=0

As you can see, I have Hire Date in Column B and I want to sum the quantity found in Column E for each category in Column D based on two date factors: Hire Date =< 45 days and Hire Date >45 days. I will be running this report every week, so I need the code to simply count back 1-45 days for the New Hire sums and 45+ days for the Tenured sums from the current date. I assume it's another autofilter type of situation, but I can't figure out how to stack one autofilter with another.

 

[GhostEcho]

How about this... It'll put the data in columns G and H for you.

Function:

Public Function MySumif(Sumit() As Variant, Searchit() As Variant, Mycrit As Variant)
Dim i As Long


MySumif = 0
For i = 1 To UBound(Searchit)
If Searchit(i, 1) = Mycrit Then MySumif = MySumif + Sumit(i, 1)
Next i
End Function

The sub that does it:

Sub TheSumMacro()
'The dims
Dim Jobs() As Variant, i As Long, ColD() As Variant, ColE() As Variant


'Gives us a unique list of all the jobs from column D into column G
Range("G1").EntireColumn.Value2 = Range("D1").EntireColumn.Value2
Range("G1").EntireColumn.RemoveDuplicates Columns:=1, Header:=xlYes
Range("H1").Value = "Totals"


'Fills the arrays for the sumif UDF
Jobs = Range("G2:G" & Range("G1").End(xlDown).Row).Value2
ColD = Range("D2:D" & Range("D1").End(xlDown).Row).Value2
ColE = Range("E2:E" & Range("E1").End(xlDown).Row).Value2


'For each of the individual jobs, it sums column E if it matches, and populates the totals next to the job name
For i = 1 To UBound(Jobs)
Cells(i + 1, 8).Value = MySumif(ColE(), ColD(), Jobs(i, 1))
Next i


MsgBox "done!"


End Sub

 

[mumps]

Try this macro. I have added a prompt for you to enter the desired job function.

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