Add occurrences of same month data

[Drawleeh]

Hello, I have a spreadsheet that looks something like this.

Id like to be able to add together the date occurrences by month in VBA (so add all the dates from January to show how many January entries there have been). But also add them together based by their category. So the output from above would be something like this but from a much larger list.

 

[Eric W]

While VBA is possible, here are some other possibilities:

Book1
	A	B	C
1	Time Changed	User	Category
2	1/1/2021	User	C285_Repayment_Overpayment
3	1/2/2021	User	C285_Repayment_Overpayment
4	2/2/2021	User	C2001_Voluntary_Underpayment
5	3/3/2021	User	C2001_Voluntary_Underpayment
6	3/3/2021	User	C2001_Voluntary_Underpayment
7	4/4/2021	User	C285_Repayment_Overpayment
8	5/4/2021	User	C285_Repayment_Overpayment
9	6/5/2021	User	C2001_Voluntary_Underpayment
10	6/5/2021	User	C2001_Voluntary_Underpayment
11	7/5/2021	User	C285_Repayment_Overpayment
12
13
14
15		C285_Repayment_Overpayment	C2001_Voluntary_Underpayment
16	January	2	0
17	February	0	1
18	March	0	2
19	April	1	0
20	May	1	0
Sheet14

Cell Formulas
Range	Formula
B16:C20	B16	=COUNTIFS($A$2:$A$11,">="&$A16,$A$2:$A$11,"<="&EOMONTH($A16,0),$C$2:$C$11,B$15)

This formula will count them easily. Note that the values in A16:A20 are actual dates, just formatted to look like a month.

Or you can just use a pivot table:

Book1
	A	B	C	D
1
2
3	Count of Category	Column Labels
4	Row Labels	C2001_Voluntary_Underpayment	C285_Repayment_Overpayment	Grand Total
5	Jan		2	2
6	Feb	1		1
7	Mar	2		2
8	Apr		1	1
9	May		1	1
10	Jun	2		2
11	Jul		1	1
12	Grand Total	5	5	10
Sheet15

To do that, just select your data, Click "Insert Pivot Table", and from the PivotTable Fields box, drag "Time Changed" to the Rows box, "Category" to the Columns and Values boxes.

 

[lrobbo314]

While Eric is correct, and you could add Power Query to that list of better solutions....

Since you asked, here's some VBA.

Book1
	A	B	C	D	E	F	G
1	Time Changed	User	Category
2	------------	------------	------------			C285	C2001
3	1/1/2021	User	C285		January	2	0
4	1/2/2021	User	C285		February	0	1
5	2/2/2021	User	C2001		March	0	2
6	3/3/2021	User	C2001		April	1	0
7	3/3/2021	User	C2001		May	1	0
8	4/4/2021	User	C285		June	0	2
9	5/4/2021	User	C285		July	1	0
10	6/5/2021	User	C2001
11	6/5/2021	User	C2001
12	7/5/2021	User	C285
Sheet1

Sub DRW()
Dim AR() As Variant:    AR = Range("A3:C" & Range("A" & Rows.Count).End(xlUp).Row).Value2
Dim Cat As Object:      Set Cat = CreateObject("Scripting.Dictionary")
Dim CH As Object:       Set CH = CreateObject("Scripting.Dictionary")
Dim MO As Object:       Set MO = CreateObject("Scripting.Dictionary")
Dim bCol As Integer:    bCol = 6
Dim Res() As Variant
Dim cId As String
Dim Mth As String

For i = 1 To UBound(AR)
    cId = AR(i, 3)
    Mth = Format(AR(i, 1), "MMMM")
    If Not Cat.exists(cId) Then
        Cat.Add cId, True
        CH.Add cId, CreateObject("Scripting.Dictionary")
    End If
    If Not MO.exists(Mth) Then MO.Add Mth, True
Next i

For i = 1 To UBound(AR)
    cId = AR(i, 3)
    Mth = Format(AR(i, 1), "MMMM")
    
    If Not CH(cId).exists(Mth) Then
        CH(cId).Add Mth, 1
    Else
        CH(cId).Item(Mth) = CH(cId).Item(Mth) + 1
    End If
Next i

FormatRange Range("E3"), MO, True
FormatRange Range("F2"), Cat, False

For Each k In Cat.keys
    For j = 0 To MO.Count - 1
        If CH(k).exists(MO.keys()(j)) Then
            Cells(j + 3, bCol) = CH(k).Item(MO.keys()(j))
        Else
            Cells(j + 3, bCol) = 0
        End If
    Next j
    bCol = bCol + 1
Next k
End Sub

Sub FormatRange(r As Range, SD As Object, b As Boolean)
If b Then
    With r.Resize(SD.Count)
        .Value = Application.Transpose(SD.keys)
        .Font.Bold = True
    End With
Else
    With r.Resize(, SD.Count)
        .Value = SD.keys
        .Font.Bold = True
    End With
End If
End Sub