CHECK if in combobox are present a block of 3 months

[sal21]

In a combobox i have a list of dates in this format dd/mm/yyyy.(not possiìble duplicates date)

i need to check, via commandbutton1, if in the combobox are present a consecutive 3 date of a block of 3 month based the selected date from combobox...

example:

date selected: 08/07/2014

07/07/2004
08/07/2014
...
14/11/2014
..
05/05/2014
30/05/2014
...
11/06/2014
02/06/2014
....

in this case i select 08/07/2014, all ok, because have at least one date of june and at least one date of may...

07/07/2004
08/07/2014
...
14/11/2014
..
05/05/2014
30/05/2014
...
11/06/2014
02/06/2014
....

date selected: 11/06/2014

no ok, i dont have at lesat one date of april but have only a may and june dates

sorry for my bad english

[HansV]

What kind of combo box is this?
1) A Forms combo box on a worksheet?
2) An ActiveX combo box on a worksheet?
3) A combo box on a userform?

[sal21]

Sorry me, in userform.

[HansV]

Try this:

Code: Select all

Private Sub CommandButton1_Click()
    Dim d As Date
    Dim d1 As Date
    Dim d2 As Date
    Dim v As Date
    Dim i As Long
    Dim f1 As Boolean
    Dim f2 As Boolean
    With Me.ComboBox1
        ' Check that user has selected a date
        If .ListIndex = -1 Then
            MsgBox "Select a date, then try again.", vbExclamation
            Exit Sub
        End If
        ' Get the selected date
        d = CDate(.Value)
        ' Beginning of previous month
        d1 = DateSerial(Year(d), Month(d) - 1, 1)
        ' Beginning of month before that
        d2 = DateSerial(Year(d), Month(d) - 2, 1)
        ' Loop through the list items
        For i = 0 To .ListCount - 1
            ' Get date
            v = CDate(.List(i))
            ' Compute first of month
            v = DateSerial(Year(v), Month(v), 1)
            ' Compare to d1
            f1 = f1 Or (v = d1)
            ' Compare to d2
            f2 = f2 Or (v = d2)
            ' If we've found both months, get out
            If f1 And f2 Then Exit For
        Next i
    End With
    ' Did we find both months?
    If f1 And f2 Then
        MsgBox "OK"
    Else
        MsgBox "Not OK"
    End If
End Sub

[sal21]

Try this:

Code: Select all

Private Sub CommandButton1_Click()
    Dim d As Date
    Dim d1 As Date
    Dim d2 As Date
    Dim v As Date
    Dim i As Long
    Dim f1 As Boolean
    Dim f2 As Boolean
    With Me.ComboBox1
        ' Check that user has selected a date
        If .ListIndex = -1 Then
            MsgBox "Select a date, then try again.", vbExclamation
            Exit Sub
        End If
        ' Get the selected date
        d = CDate(.Value)
        ' Beginning of previous month
        d1 = DateSerial(Year(d), Month(d) - 1, 1)
        ' Beginning of month before that
        d2 = DateSerial(Year(d), Month(d) - 2, 1)
        ' Loop through the list items
        For i = 0 To .ListCount - 1
            ' Get date
            v = CDate(.List(i))
            ' Compute first of month
            v = DateSerial(Year(v), Month(v), 1)
            ' Compare to d1
            f1 = f1 Or (v = d1)
            ' Compare to d2
            f2 = f2 Or (v = d2)
            ' If we've found both months, get out
            If f1 And f2 Then Exit For
        Next i
    End With
    ' Did we find both months?
    If f1 And f2 Then
        MsgBox "OK"
    Else
        MsgBox "Not OK"
    End If
End Sub

Great!
... only for you

hummmmmmm... possible to intercept the month/months not present in block of 3?

[HansV]

Change the last part to

Code: Select all

    ' Did we find both months?
    If f1 And f2 Then
        MsgBox "OK"
    ElseIf f1 And Not f2 Then
        MsgBox Format(d2, "mmmm") & " is missing", vbInformation
    ElseIf f2 And Not f1 Then
        MsgBox Format(d1, "mmmm") & " is missing", vbInformation
    Else
        MsgBox Format(d2, "mmmm") & " and " & Format(d1, "mmmm") & " are missing", vbInformation
    End If

[sal21]

Change the last part to

Code: Select all

    ' Did we find both months?
    If f1 And f2 Then
        MsgBox "OK"
    ElseIf f1 And Not f2 Then
        MsgBox Format(d2, "mmmm") & " is missing", vbInformation
    ElseIf f2 And Not f1 Then
        MsgBox Format(d1, "mmmm") & " is missing", vbInformation
    Else
        MsgBox Format(d2, "mmmm") & " and " & Format(d1, "mmmm") & " are missing", vbInformation
    End If

Sure you write this piece of code on fly. Work perfect!

But:
"Can you lend a milligram of YOUR BRAIN"?

[HansV]