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

T_Bos

New Member
Joined
Nov 29, 2020
Messages
15
Office Version
  1. 365
Platform
  1. Windows
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.


1606703449114.png


Thank you for your help in advance.
Travis.
 

Attachments

  • 1606702895564.png
    1606702895564.png
    17.8 KB · Views: 2

Some videos you may like

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"

alansidman

Well-known Member
Joined
Feb 26, 2007
Messages
6,146
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
What about a pivot table

Book3
ABCDEFGH
1DateStatus
27/1/2020EarlyCount of StatusStatus
37/3/2020EarlyMonthsAbsentEarlyLateGrand Total
47/5/2020LateJul213
58/1/2020LateAug1113
68/3/2020EarlyOct1113
78/5/2020AbsentGrand Total2439
810/1/2020Absent
910/3/2020Late
1010/5/2020Early
Sheet1
 

T_Bos

New Member
Joined
Nov 29, 2020
Messages
15
Office Version
  1. 365
Platform
  1. Windows
What about a pivot table

Book3
ABCDEFGH
1DateStatus
27/1/2020EarlyCount of StatusStatus
37/3/2020EarlyMonthsAbsentEarlyLateGrand Total
47/5/2020LateJul213
58/1/2020LateAug1113
68/3/2020EarlyOct1113
78/5/2020AbsentGrand Total2439
810/1/2020Absent
910/3/2020Late
1010/5/2020Early
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

Well-known Member
Joined
Feb 26, 2007
Messages
6,146
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
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

New Member
Joined
Nov 29, 2020
Messages
15
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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?

1606794219685.png
 

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
17,411
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
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
ABCDEFGH
1DateStatusMonths# of Records# Early# Late# Absent
27/1/2020EarlyJuly321
37/3/2020EarlyAugust3111
47/5/2020LateOctober3111
58/1/2020Late
68/3/2020Early
78/5/2020Absent
810/1/2020Absent
910/3/2020Late
1010/5/2020Early
Sheet13

VBA Code:
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

New Member
Joined
Nov 29, 2020
Messages
15
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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:
1606795192786.png
 

alansidman

Well-known Member
Joined
Feb 26, 2007
Messages
6,146
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
An alternative is to use Power Query.

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

New Member
Joined
Nov 29, 2020
Messages
15
Office Version
  1. 365
Platform
  1. Windows
An alternative is to use Power Query.

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:

1606868189698.png


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?

1606868566822.png
 

T_Bos

New Member
Joined
Nov 29, 2020
Messages
15
Office Version
  1. 365
Platform
  1. Windows
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
ABCDEFGH
1DateStatusMonths# of Records# Early# Late# Absent
27/1/2020EarlyJuly321
37/3/2020EarlyAugust3111
47/5/2020LateOctober3111
58/1/2020Late
68/3/2020Early
78/5/2020Absent
810/1/2020Absent
910/3/2020Late
1010/5/2020Early
Sheet13

VBA Code:
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!
 

Watch MrExcel Video

Forum statistics

Threads
1,127,107
Messages
5,622,782
Members
415,927
Latest member
vedasinternational

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
Top