VBA code to find the number of different months in a column of dates and list them...

[T_Bos]

Hello All,
I am new to VBA and have run into a roadblock that I need help with. I normally generate an Excel report that generates a column of dates and attendance status (see below Columns A and B). What I need to accomplish is to write a VBA code that:
1. Loop through column A and find the number of different months and list them in column D. In the below example, it would be 3 different months so cells D2, D3, D4 would have July, August, and October respectively
2. For each month, find the number of records. In the below example, it would be 3 for each month so cells E2, E3, E4 would have 3, 3, and 3 respectively
3. For each month, find the number Early, Late, Absent records and list them in columns F, G, and H respectively.

Thank you for your help in advance.
Travis.

 

[alansidman]

What about a pivot table

Book3
	A	B	C	D	E	F	G	H
1	Date	Status
2	7/1/2020	Early		Count of Status	Status
3	7/3/2020	Early		Months	Absent	Early	Late	Grand Total
4	7/5/2020	Late		Jul		2	1	3
5	8/1/2020	Late		Aug	1	1	1	3
6	8/3/2020	Early		Oct	1	1	1	3
7	8/5/2020	Absent		Grand Total	2	4	3	9
8	10/1/2020	Absent
9	10/3/2020	Late
10	10/5/2020	Early
Sheet1

 

[T_Bos]

What about a pivot table

Book3
	A	B	C	D	E	F	G	H
1	Date	Status
2	7/1/2020	Early		Count of Status	Status
3	7/3/2020	Early		Months	Absent	Early	Late	Grand Total
4	7/5/2020	Late		Jul		2	1	3
5	8/1/2020	Late		Aug	1	1	1	3
6	8/3/2020	Early		Oct	1	1	1	3
7	8/5/2020	Absent		Grand Total	2	4	3	9
8	10/1/2020	Absent
9	10/3/2020	Late
10	10/5/2020	Early
Sheet1

Hello Alansidman,

Thank you so much for taking the time out to do this for me. I thought about a Pivot Table, but I want to fully automate this function each time this report is printed. This will be part of a bigger Macro and is looking for the VBA code to accomplish it unless I could automate this pivot table with code.

Thanks.

 

[alansidman]

Use the macro recorder to build your PT and then if you need additional help in modifying it, then post your code here with an explanation of what needs to be changed.

 

[T_Bos]

Use the macro recorder to build your PT and then if you need additional help in modifying it, then post your code here with an explanation of what needs to be changed.

Thanks for the suggestion, I did that at captured the code. Now can you help me with a PT function. Suppose I have the additional column of Time Out and I want to add just the "Auto" records for the same months to the PT and include them in the Grand Total. So basically there would be another column in the PT name Time Out that only include the "Auto" Records. How do I do that?

 

[JoeMo]

Here's a macro you can try if you're still interested in a VBA solution. The layout is as you have shown it in your image. The result of running the macro is below.

Book1.xlsm
	A	B	C	D	E	F	G	H
1	Date	Status		Months	# of Records	# Early	# Late	# Absent
2	7/1/2020	Early		July	3	2	1
3	7/3/2020	Early		August	3	1	1	1
4	7/5/2020	Late		October	3	1	1	1
5	8/1/2020	Late
6	8/3/2020	Early
7	8/5/2020	Absent
8	10/1/2020	Absent
9	10/3/2020	Late
10	10/5/2020	Early
Sheet13

Sub T_Bos()
Dim R As Range, V As Variant, d As Object, i As Long, j As Long
Set R = Range("A1").CurrentRegion
V = R.Value
Set d = CreateObject("scripting.dictionary")
ReDim X(1 To UBound(V, 1), 1 To 4)
For i = 1 To UBound(V, 1)
    If IsDate(V(i, 1)) Then
        If Not d.exists(MonthName(Month(V(i, 1)))) Then
            d.Add MonthName(Month(V(i, 1))), d.Count + 1
        End If
    End If
Next i
Range("D2:D" & d.Count + 1) = Application.Transpose(d.keys)
For j = 2 To Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row).Count + 1
    For i = 1 To UBound(V, 1)
        If IsDate(V(i, 1)) Then
            If Cells(j, "D").Value = MonthName(Month(V(i, 1))) Then
                Cells(j, "E").Value = Cells(j, "E").Value + 1
                Select Case V(i, 2)
                    Case "Early": Cells(j, "F").Value = Cells(j, "F").Value + 1
                    Case "Late": Cells(j, "G").Value = Cells(j, "G").Value + 1
                    Case "Absent": Cells(j, "H").Value = Cells(j, "H").Value + 1
                End Select
            End If
        End If
    Next i
Next j
End Sub

 

[T_Bos]

Thanks for the suggestion, I did that at captured the code. Now can you help me with a PT function. Suppose I have the additional column of Time Out and I want to add just the "Auto" records for the same months to the PT and include them in the Grand Total. So basically there would be another column in the PT name Time Out that only include the "Auto" Records. How do I do that?

View attachment 26979

Sorry, the table would look like the below:

 

[alansidman]

An alternative is to use Power Query.

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Date", type date}}),
    #"Inserted Month Name" = Table.AddColumn(#"Changed Type", "Month Name", each Date.MonthName([Date]), type text),
    #"Removed Columns" = Table.RemoveColumns(#"Inserted Month Name",{"Date"}),
    #"Pivoted Column" = Table.Pivot(#"Removed Columns", List.Distinct(#"Removed Columns"[Status]), "Status", "Time Out", List.Count)
in
    #"Pivoted Column"

Power Query is a free AddIn for Excel 2010 and 2013, and is built-in functionality from Excel 2016 onwards (where it is referred to as "Get & Transform Data").

It is a powerful yet simple way of getting, changing and using data from a broad variety of sources, creating steps which may be easily repeated and refreshed. I strongly recommend learning how to use Power Query - it's among the most powerful functionalities of Excel.

- Follow this link to learn how to install Power Query in Excel 2010 / 2013.

- Follow this link for an introduction to Power Query functionality.

- Follow this link for a video which demonstrates how to use Power Query code provided.

 

[T_Bos]

An alternative is to use Power Query.

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Date", type date}}),
    #"Inserted Month Name" = Table.AddColumn(#"Changed Type", "Month Name", each Date.MonthName([Date]), type text),
    #"Removed Columns" = Table.RemoveColumns(#"Inserted Month Name",{"Date"}),
    #"Pivoted Column" = Table.Pivot(#"Removed Columns", List.Distinct(#"Removed Columns"[Status]), "Status", "Time Out", List.Count)
in
    #"Pivoted Column"

Power Query is a free AddIn for Excel 2010 and 2013, and is built-in functionality from Excel 2016 onwards (where it is referred to as "Get & Transform Data").

It is a powerful yet simple way of getting, changing and using data from a broad variety of sources, creating steps which may be easily repeated and refreshed. I strongly recommend learning how to use Power Query - it's among the most powerful functionalities of Excel.

- Follow this link to learn how to install Power Query in Excel 2010 / 2013.

- Follow this link for an introduction to Power Query functionality.

- Follow this link for a video which demonstrates how to use Power Query code provided.

Thanks Alanisdman.

However, when I executed that Power Query, I dont get the Auto records in the table. I get this:

I like the Pivot Table option as I can easily generate some graphs. Basically, I woul love the Pivot Table output to look like the below with the "Time Out" column added but just the "Auto" records. I can get the Pivot Table like you originally suggested but I can't seem to add in the "Time Out" column with just the "Auto" records. Do you know how to create the Pivot Table to look like the below?

 

[T_Bos]

Here's a macro you can try if you're still interested in a VBA solution. The layout is as you have shown it in your image. The result of running the macro is below.

Book1.xlsm
	A	B	C	D	E	F	G	H
1	Date	Status		Months	# of Records	# Early	# Late	# Absent
2	7/1/2020	Early		July	3	2	1
3	7/3/2020	Early		August	3	1	1	1
4	7/5/2020	Late		October	3	1	1	1
5	8/1/2020	Late
6	8/3/2020	Early
7	8/5/2020	Absent
8	10/1/2020	Absent
9	10/3/2020	Late
10	10/5/2020	Early
Sheet13

Sub T_Bos()
Dim R As Range, V As Variant, d As Object, i As Long, j As Long
Set R = Range("A1").CurrentRegion
V = R.Value
Set d = CreateObject("scripting.dictionary")
ReDim X(1 To UBound(V, 1), 1 To 4)
For i = 1 To UBound(V, 1)
    If IsDate(V(i, 1)) Then
        If Not d.exists(MonthName(Month(V(i, 1)))) Then
            d.Add MonthName(Month(V(i, 1))), d.Count + 1
        End If
    End If
Next i
Range("D2:D" & d.Count + 1) = Application.Transpose(d.keys)
For j = 2 To Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row).Count + 1
    For i = 1 To UBound(V, 1)
        If IsDate(V(i, 1)) Then
            If Cells(j, "D").Value = MonthName(Month(V(i, 1))) Then
                Cells(j, "E").Value = Cells(j, "E").Value + 1
                Select Case V(i, 2)
                    Case "Early": Cells(j, "F").Value = Cells(j, "F").Value + 1
                    Case "Late": Cells(j, "G").Value = Cells(j, "G").Value + 1
                    Case "Absent": Cells(j, "H").Value = Cells(j, "H").Value + 1
                End Select
            End If
        End If
    Next i
Next j
End Sub

Thanks Joe!