Dim MyDate as Date, Mydate.Day < 16 not working.

[JohanD]

Hi,

Next code takes certain values of cells and copies them into a new file. I wish to test if the entered date 'MyDate' is before the 16th or not but

'If MyDate.Day < 16 Then...' doesn't work

The code works fine but the editor tells me Mydate is not qualified.
can somebody help me

Sub Opmakenfactuur()
    On Error GoTo Err_Execute
    Dim r As Integer 'rows increment in first worksheet
    Dim r2 As Integer 'rows increment in second worksheet
    Dim WS1 As Worksheet
    Dim WB2 As Workbook, WS2 As Worksheet
    Dim MyDate As Date
    Dim wanden As Boolean
    Dim space As Boolean
    inProductie = RGB(255, 153, 204)
    Set WS1 = Sheets(1)
    'sort on the first column then on the 3rd
    WS1.Range("A6").Sort Key1:=WS1.Range("A7"), Order1:=xlDescending, Key2:=WS1.Range("C7"), _
        Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=True, _
        Orientation:=xlTopToBottom
    
    MyDate = Application.InputBox("Geef de Datum in vanaf welke dient berekent te worden.", "Opmaken Factuur")
    If MyDate = False Then Exit Sub
    Set NewBook = Workbooks.Add
    Set WS2 = NewBook.Sheets(1)
    Application.ScreenUpdating = False
    r = 7
    r2 = 6
    MsgBox MyDate.Day 
    While Len(WS1.Range("A" & CStr(r)).Value) <> 0
        If MyDate.Day < 16 Then
            If WS1.Range("G" & CStr(r)).Value >= MyDate And WS1.Range("G" & CStr(r)).Interior.Color = inProductie Then
                WS1.Range("A" & CStr(r)).Copy Destination:=WS2.Cells(r2, 1)
                WS1.Range("C" & CStr(r)).Copy Destination:=WS2.Cells(r2, 2)
                WS1.Range("B" & CStr(r)).Copy Destination:=WS2.Cells(r2, 3)
                WS1.Range("M" & CStr(r)).Copy Destination:=WS2.Cells(r2, 4)
                WS1.Range("N" & CStr(r)).Copy Destination:=WS2.Cells(r2, 5)
                WS1.Range("H" & CStr(r)).Copy Destination:=WS2.Cells(r2, 6)
                r2 = r2 + 1
            End If
        End If
        r = r + 1
       Wend
        'first rows
    WS2.Range("A2").Value = "DECKEN"
    WS2.Range("D2").Value = "m²"
    WS2.Range("E2").Value = "€/m²"
    WS2.Range("F2").Value = "€"
    
    WS2.Range("A5").Sort Key1:=WS2.Range("E6"), Order1:=xlAscending, _
    Key2:=WS2.Range("D6"), Order2:=xlAscending, _
    Header:=xlGuess, OrderCustom:=1, MatchCase:=True, Orientation:=xlTopToBottom
    WS2.Cells.Style = "Standaard" 'set style to black text no layout.
    WS2.Range("A5").Value = "< 500 m²/Stock"
    WS2.Range("A5").Font.Bold = True
    r2 = 6
    wanden = True
    space = False
    While Len(WS2.Range("A" & CStr(r2)).Value) <> 0
        WS2.Range("A" & CStr(r2)).Select
        '>500
        If WS2.Range("D" & CStr(r2)).Value > 500 And space = False Then
            For i = 1 To 3
                WS2.Rows(CStr(r2) & ":" & CStr(r2)).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                If i = 3 Then
                    WS2.Range("A" & CStr(r2)).Value = "> 500 m²"
                    WS2.Range("A" & CStr(r2)).Font.Bold = True
                End If
                r2 = r2 + 1
            Next i
            space = True
        End If
        'dallen
        If WS2.Range("E" & CStr(r2)).Value <> "w" And wanden = True Then
            wanden = False
            For i = 1 To 5
                WS2.Rows(CStr(r2) & ":" & CStr(r2)).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                If i = 5 Then
                    WS2.Range("A" & CStr(r2)).Value = "< 500 m²/Stock"
                    WS2.Range("A" & CStr(r2)).Font.Bold = True
                End If
                r2 = r2 + 1
            Next i
            space = False
        End If
        r2 = r2 + 1
    Wend
    Application.ScreenUpdating = True
    Beep
    Do
        fName = Application.GetSaveAsFilename
    Loop Until fName <> False
    NewBook.SaveAs Filename:=fName & ".xlsx"

Exit Sub
Err_Execute:
        MsgBox "An error occurred."

 

[Richard Schollar]

Dates are simple scalar variables in VBA so they have no properties/methods of their own. You need:

If Day(myDate) < 16 Then '...