Consulting

Page 1 of 2 1 2 LastLast
Results 1 to 20 of 25

Thread: Counting Dates

  1. #1

    Counting Dates

    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

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master xld's Avatar
    Joined
    Apr 2005
    Posts
    25,147
    Location
    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]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    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
    Last edited by thomas.szwed; 02-13-2008 at 04:54 AM. Reason: Update

  4. #4
    Distinguished Lord of VBAX VBAX Grand Master xld's Avatar
    Joined
    Apr 2005
    Posts
    25,147
    Location
    Quote Originally Posted by thomas.szwed
    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?

    Quote Originally Posted by thomas.szwed
    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?

    Quote Originally Posted by thomas.szwed
    Added in the test for reference.
    What does that mean?
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  5. #5
    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

  6. #6
    Any clues??? It looks abit challenging i must admit

  7. #7
    Distinguished Lord of VBAX VBAX Grand Master xld's Avatar
    Joined
    Apr 2005
    Posts
    25,147
    Location
    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.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  8. #8

    XLD -

    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....

  9. #9
    Distinguished Lord of VBAX VBAX Grand Master xld's Avatar
    Joined
    Apr 2005
    Posts
    25,147
    Location
    [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]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  10. #10

    Number of

    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...

  11. #11
    Distinguished Lord of VBAX VBAX Grand Master xld's Avatar
    Joined
    Apr 2005
    Posts
    25,147
    Location
    [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]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  12. #12
    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

  13. #13
    Distinguished Lord of VBAX VBAX Grand Master xld's Avatar
    Joined
    Apr 2005
    Posts
    25,147
    Location
    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]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  14. #14
    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.

  15. #15
    Distinguished Lord of VBAX VBAX Grand Master xld's Avatar
    Joined
    Apr 2005
    Posts
    25,147
    Location
    [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]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  16. #16
    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

  17. #17
    Moderator VBAX Guru Simon Lloyd's Avatar
    Joined
    Sep 2005
    Location
    UK
    Posts
    3,003
    Location
    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?
    Regards,
    Simon
    Please read this before cross posting!
    In the unlikely event you didn't get your answer here try Microsoft Office Discussion @ The Code Cage
    If I have seen further it is by standing on the shoulders of giants.
    Isaac Newton, Letter to Robert Hooke, February 5, 1675 English mathematician & physicist (1642 - 1727)

  18. #18
    Moderator VBAX Guru Simon Lloyd's Avatar
    Joined
    Sep 2005
    Location
    UK
    Posts
    3,003
    Location
    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
    Regards,
    Simon
    Please read this before cross posting!
    In the unlikely event you didn't get your answer here try Microsoft Office Discussion @ The Code Cage
    If I have seen further it is by standing on the shoulders of giants.
    Isaac Newton, Letter to Robert Hooke, February 5, 1675 English mathematician & physicist (1642 - 1727)

  19. #19
    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..

  20. #20
    Moderator VBAX Guru Simon Lloyd's Avatar
    Joined
    Sep 2005
    Location
    UK
    Posts
    3,003
    Location
    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.
    Regards,
    Simon
    Please read this before cross posting!
    In the unlikely event you didn't get your answer here try Microsoft Office Discussion @ The Code Cage
    If I have seen further it is by standing on the shoulders of giants.
    Isaac Newton, Letter to Robert Hooke, February 5, 1675 English mathematician & physicist (1642 - 1727)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •