PDA

View Full Version : Counting Dates



thomas.szwed
02-13-2008, 03:05 AM
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
02-13-2008, 04:12 AM
Put the month number in D1, and use

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

or a macr



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

thomas.szwed
02-13-2008, 04:51 AM
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
02-13-2008, 05:03 AM
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
02-13-2008, 05:15 AM
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
02-13-2008, 09:16 AM
Any clues??? It looks abit challenging i must admit

Bob Phillips
02-13-2008, 10:17 AM
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
02-14-2008, 02:40 AM
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....:hi:

Bob Phillips
02-14-2008, 04:07 AM
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

thomas.szwed
03-05-2008, 02:38 AM
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
03-05-2008, 03:01 AM
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

thomas.szwed
03-14-2008, 08:56 AM
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
03-14-2008, 09:09 AM
That was nice and easy <g>



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

thomas.szwed
03-14-2008, 09:43 AM
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
03-14-2008, 10:56 AM
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

thomas.szwed
03-18-2008, 09:45 AM
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
03-18-2008, 10:00 AM
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
03-18-2008, 10:04 AM
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 (http://www.vbaexpress.com/kb/getarticle.php?kb_id=142)

thomas.szwed
03-18-2008, 10:15 AM
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
03-18-2008, 10:29 AM
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.

thomas.szwed
03-19-2008, 07:48 AM
I have now entered all the code myself and tested this working on my 'Test' workbook. It worked flawlessy.

however i have now come to use the code in my application and am experiencing a 'mismatch error'. I have attached the workbook, so please open it up (password is "pastille"). Then press Alt+F8 to see the macros. Run the macro "Count Dates" and then have a look at the problem.

To remind you of the macro's function. It simply asks the user to enter the month format of dates they are searching for into a textbox (so for Jan you would enter 01) and then it searches column J in both sheets for matching months and brings back the result in a message box....

THanks!

Aussiebear
03-19-2008, 09:32 AM
When I run your code it provides an run time error (13) Type mismatch, and highlights the following line

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

Is this what you get Thomas?

Help suggests that either

A Variable or Property isn't of the correct type, or
An Object was passed to a Procedure, or
A Module or Project Name was used where an expression was expected.

thomas.szwed
03-19-2008, 09:34 AM
yes it is........but i make no sense of the help?

Do you know how to fix this problem?

Aussiebear
03-19-2008, 09:51 AM
In your post #21, you indicated that "I have now entered all the code myself and tested this working on my 'Test' workbook. It worked flawlessy."

What is different between the sections of code, (apart from the unprotect/protect lines of code?

Simon Lloyd
03-19-2008, 11:37 AM
Does this line:

If Month(.Cells(i, TEST_COLUMN).Value2) = mpMonth Then
not fault because in effect it says this:
If Month in mpSheet in the range of Cells (1,J).value2....etc, whereas it should read:
if Month in mpSHeet in the range of Cells(1,10).value2...etc.

I might be wrong of course....as i quite often am!