Counting Dates

[thomas.szwed]

Hello,

Would it be possible to create a Sub that counts the number of paticular dates in a column. For example i have a column in a spreadsheet that contains many dates in the format dd/mm/yyyy. I would like a function to count the amount of dates from a specified month.

So for example when you run the sub a box comes up asking for you to enter the month digits (e.g. Jan = 01 - so you would enter 01). Then it would search the date column in the spreadsheet for all dates that contain 01 in the mm part of dd/mm/yyyy, and then show the number of dates it found containing dd/01/yyyy.

Any help would be much appreciated.

Thanks

[Bob Phillips]

Put the month number in D1, and use

=SUMPRODUCT(--(ISNUMBER(A2:A200)),--(YEAR(A2:A200)=D1))

or a macr

[vba]

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim mpLastRow As Long
Dim mpMonth As Long

With ActiveSheet

mpMonth = InputBox("Supply date month")
If mpMonth >= 1 And mpMonth <= 12 Then

mpLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
.Range("A1").Resize(mpLastRow).Interior.ColorIndex = xlColorIndexNone
For i = 1 To mpLastRow 'iLastRow to 1 Step -1

If IsNumeric(.Cells(i, TEST_COLUMN).Value2) Then

If Month(.Cells(i, TEST_COLUMN).Value2) = mpMonth Then

.Cells(i, TEST_COLUMN).Interior.ColorIndex = 38
End If
End If
Next i
End If
End With

End Sub
[/vba]

[thomas.szwed]

Couple of questions.........

the range is down as A1 ( therefore is it only looking at dates in this cell?? not the whole column?) And will there be confusion with 01....? 0s in front on the month number?

Secondly where does the number of records that match the criteria entered show? Could it appear in an information box?

Added in the test for reference.

Thanks &

Kind Regards,

Tom

[Bob Phillips]

the range is down as A1 ( therefore is it only looking at dates in this cell?? not the whole column?) And will there be confusion with 01....? 0s in front on the month number?

What does that mean?

Secondly where does the number of records that match the criteria entered show? Could it appear in an information box?

Won't this be a tad large to assimilate?

Added in the test for reference.

What does that mean?

[thomas.szwed]

Sorry to clarify.

1. Was the 'TEST COLUMN' character as A in your code - does this need to be changed to column containing the dates?

2. OK. Say if you entered 01 into the input box. It then looked through all the dates and found 5 that were dd/01/yyyy. Where does this result show? Ideally i would want a messge box saying "5 records found". You get me?

3. Ive included my testing workbook for you to see/edit the code in action (although its not working properly yet!)

Hope this helps.

Thanks

[thomas.szwed]

Any clues??? It looks abit challenging i must admit

[Bob Phillips]

No it is very simple, I just suggested highlighting the matches rather than throw up a dialog.

But ... it won't work as you have the workbook is because all ofd the dates are tecxt, and to test for the month, you need proper dates.

[thomas.szwed]

I have now changed the format of the dates from text to dates. I have tried running the macro and it doesnt appear to do anything? Please take a look at my attached spreadsheet for reference. Would it be possible to create an information box as opposed to highlighting the dates?

Many Thanks for any Help....

[Bob Phillips]

[vba]

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim mpLastRow As Long
Dim mpMonth As Long
Dim mpDates As Collection
Dim mpItem As Variant
Dim mpMessage

With ActiveSheet

mpMonth = InputBox("Supply date month")
If mpMonth >= 1 And mpMonth <= 12 Then

Set mpDates = New Collection

mpLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
.Range("A1").Resize(mpLastRow).Interior.ColorIndex = xlColorIndexNone
For i = 1 To mpLastRow 'iLastRow to 1 Step -1

If Month(.Cells(i, TEST_COLUMN).Value2) = mpMonth Then

On Error Resume Next
mpDates.Add .Cells(i, TEST_COLUMN).Text, .Cells(i, TEST_COLUMN).Text
On Error GoTo 0
End If
Next i

For Each mpItem In mpDates

mpMessage = mpMessage & " " & mpItem & vbNewLine
Next mpItem

MsgBox "Matching dates:" & vnewline & vbNewLine & mpMessage, vbOKOnly + vbInformation
End If
End With

End Sub
[/vba]

[thomas.szwed]

Hi XLD.

Thanks for the reply. As you can see in the attached screenshot this code brings up a box listing all the dates it found that matched your user input.

Would there be a way to also display the number of matching records found? So if you entered 01 in the month and it displayed all the dd/01/yyyy records, could it also say "10 records found" for example?

Many Thanks...

[Bob Phillips]

[vba]

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim mpLastRow As Long
Dim mpMonth As Long
Dim mpDates As Collection
Dim mpItem As Variant
Dim mpMessage As String
Dim mpCount As Long

With ActiveSheet

mpMonth = InputBox("Supply date month")
If mpMonth >= 1 And mpMonth <= 12 Then

Set mpDates = New Collection

mpLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
.Range("A1").Resize(mpLastRow).Interior.ColorIndex = xlColorIndexNone
For i = 1 To mpLastRow 'iLastRow to 1 Step -1

If Month(.Cells(i, TEST_COLUMN).Value2) = mpMonth Then

On Error Resume Next
mpDates.Add .Cells(i, TEST_COLUMN).Text, .Cells(i, TEST_COLUMN).Text
On Error GoTo 0
End If
Next i

For Each mpItem In mpDates

mpMessage = mpMessage & " " & mpItem & vbNewLine
mpCount = mpCount + 1
Next mpItem

MsgBox "Matching dates:" & vnewline & vbNewLine & mpMessage & vbNewLine & _
mpCount & " records found", vbOKOnly + vbInformation
End If
End With

End Sub
[/vba]

[thomas.szwed]

Thanks XLD....

Your solution works but there is a slight problem. If there are several of the dates it only counts one. So for example in the sheet (attached) there are many 04/01/2008.....but when i run the counting macro it only counts one result.....Can this be fixed?

Thanks

[Bob Phillips]

That was nice and easy <g>

[vba]

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim mpLastRow As Long
Dim mpMonth As Long
Dim mpDates As Collection
Dim mpItem As Variant
Dim mpMessage As String
Dim mpCount As Long

With ActiveSheet

mpMonth = InputBox("Supply date month")
If mpMonth >= 1 And mpMonth <= 12 Then

Set mpDates = New Collection

mpLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
.Range("A1").Resize(mpLastRow).Interior.ColorIndex = xlColorIndexNone
For i = 1 To mpLastRow 'iLastRow to 1 Step -1

If Month(.Cells(i, TEST_COLUMN).Value2) = mpMonth Then

mpCount = mpCount + 1
On Error Resume Next
mpDates.Add .Cells(i, TEST_COLUMN).Text, .Cells(i, TEST_COLUMN).Text
On Error GoTo 0
End If
Next i

For Each mpItem In mpDates

mpMessage = mpMessage & " " & mpItem & vbNewLine
Next mpItem

MsgBox "Matching dates:" & vnewline & vbNewLine & mpMessage & vbNewLine & _
mpCount & " records found", vbOKOnly + vbInformation
End If
End With
End Sub
[/vba]

[thomas.szwed]

Gr8! one more thing tho!

I have now added in a load of dates in Sheet 3 aswell. Can we get the code to check multiple sheets???? So in this case dates in both Sheet 2 and Sheet 3.....See attched example.

[Bob Phillips]

[vba]

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim mpSheet As Worksheet
Dim mpLastRow As Long
Dim mpMonth As Long
Dim mpDates As Collection
Dim mpItem As Variant
Dim mpMessage As String
Dim mpCount As Long

mpMonth = InputBox("Supply date month")
If mpMonth >= 1 And mpMonth <= 12 Then

Set mpDates = New Collection

For Each mpSheet In ActiveWorkbook.Worksheets

With mpSheet

mpLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
.Range("A1").Resize(mpLastRow).Interior.ColorIndex = xlColorIndexNone
For i = 1 To mpLastRow 'iLastRow to 1 Step -1

If Month(.Cells(i, TEST_COLUMN).Value2) = mpMonth Then

mpCount = mpCount + 1
On Error Resume Next
mpDates.Add .Cells(i, TEST_COLUMN).Text, .Cells(i, TEST_COLUMN).Text
On Error GoTo 0
End If
Next i
End With
Next mpSheet

For Each mpItem In mpDates

mpMessage = mpMessage & " " & mpItem & vbNewLine
Next mpItem

MsgBox "Matching dates:" & vnewline & vbNewLine & mpMessage & vbNewLine & _
mpCount & " records found", vbOKOnly + vbInformation
End If
End Sub
[/vba]

[thomas.szwed]

Thanks XLD. My final problem is now i have password protected both of my sheets and the workbook structure....the password is "product". But when i try to run the macro it doesn't work because of this. Is there some code out there to unprotect whilst running the macro?

Thanks

[Simon Lloyd]

thomas, if you look back over all the help xld has given you will find you haven't actually worked on a solution yourself.....why not use the macro recorder to record the action of protecting and unprotecting a worksheet then look at the code for it and take it from there?

[Simon Lloyd]

You could always search the kb here! here's one article, you don't need it quite like this but aits a starting ppoint for you! kb entry by DRJ

[thomas.szwed]

Thats because i'm not a vb coder........XLD is kind enough to give me some code to use.....I appreciate the forums but i simply dont have the time......

This KB article doesn't cover all my needs unfortunately....i need to unprotect just when the macro is pushed....needs to be reprotected after that..

[Simon Lloyd]

Thats what that entry is......a macro! for that matter you could just cut n paste the whole code in that entry to a standard module and then use Call THATMACRONAME but seriously if you record the macro you will see what code is involved in the two actions and you will manage it from there.