Filtering Pivot table VB error due to non date values

Question

I have a Pivot table and a button to filter between 2 dates. When I click the button I get an error 1004 Application Defined or Object Defined error

I found the error was due to some non date values in the source cells on some rows.. when I change them to date values the code works correctly.

What I would like to know is there I way I can ignore these values, ie so non date values are ignored and not used in the filter? Currently the error stops the macro from continuing.

here's the code I have

Dim Invoice_Start_Date As Date
Dim Invoice_End_Date As Date
Invoice_Start_Date = CDate(Worksheets("Despatch Template").Cells(17, "F").Value)
Invoice_End_Date = CDate(Worksheets("Despatch Template").Cells(17, "G").Value)
Sheets("Despatch Template").Select

MsgBox IsDate(Invoice_End_Date)
MsgBox IsDate(Invoice_Start_Date)

ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
ActiveSheet.PivotTables("PivotTable1").PivotFields("DESPATCH 
DATE").ClearAllFilters
ActiveSheet.PivotTables("PivotTable1").PivotFields("DESPATCH 
DATE").PivotFilters.Add2 _
Type:=xlDateBetween, Value1:=CLng(Invoice_Start_Date), 
Value2:=CLng(Invoice_End_Date)

Answer 1

You can filter for "*" in your Source Data to find the non-date values, and use WorksheetFunction.CountIf with a criteria of "*" to check how many there are in the column.

If it is more than 1 (the header) then you can display an error message, show the Source Data filtered for the invalid rows, and tell the user to fix it.

If all else fails, loop through each PivotItem in the PivotField, and set the PivotItem.Visible value manually. You may want to ensure that PivotTable.ManualUpdate is True while you do this, so that it does not try to recalculate the PivotTable for every item in the field.

Example code:

Dim pTable AS PivotTable, pItem As PivotItem

Set pTable = ActiveSheet.PivotTables("PivotTable1")

pTable.ManualUpdate = True

pTable.PivotFields("DESPATCH DATE").ClearAllFilters
For Each pItem In pTable.PivotFields("DESPATCH DATE")
    If IsDate(pItem.Value) Then
        If pItem.Value >= Invoice_Start_Date AND pItem.Value <= Invoice_End_Date Then
            pItem.Visible = True
        Else
            pItem.Visible = False
        End If
    Else
        pItem.Visible = False
    End If
Next pItem

pTable.ManualUpdate = False
pTable.Update

Answer 2

The code below calls a function which will return Not True if the value retrieved from the Dispatch Template isn't a date, and that causes the row not to be processed. I have constructed it to perform in a loop but you will probably be able to adapt the methods for slightly different applications.

Private Sub CheckDate()

    Dim Dstart As Variant                       ' invoice start date
    Dim Dend As Variant

    If GetDate(17, 6, Dstart) Then
        If GetDate(17, 7, Dend) Then
            With Worksheets("Despatch Template").PivotTables("PivotTable1")
                .PivotCache.Refresh
                ' does this field name really have a blank at its end?
                With .PivotFields("DESPATCH Date ")
                    .ClearAllFilters ""
                    .PivotFilters.Add2 Type:=xlDateBetween, _
                                       Value1:=Dstart, _
                                       Value2:=Dend
                End With
            End With
        End If
    End If
End Sub

Private Function GetDate(R As Long, _
                         Clm As Long, _
                         Dat As Variant) As Boolean

    Dat = Worksheets("Despatch Template").Cells(R, Clm).Value
    If IsDate(Dat) Then
        Dat = CLng(Dat)
        GetDate = True
    End If
End Function

The above code is untested. Edit 31/01/2019 ================= The code below will identify cells that don't contain a date. Instead of showing a message box you could take rectifying action.

Private Sub CorrectDates()

    Const Clm As Long = 3               ' your dates column (3 = C)
    Const FirstDataRow As Long = 2      ' presuming row 1 to hold captions

    Dim Ws As Worksheet
    Dim Dat As Variant
    Dim Rl As Long                      ' last used row in column Clm
    Dim R As Long

    Set Ws = ActiveSheet                ' change as appropriate
    With Ws
        Rl = .Cells(.Rows.Count, Clm).End(xlUp).Row
        For R = FirstDataRow To Rl
            If Not GetDate(.Cells(R, Clm), Dat) Then
                MsgBox "Cell " & .Cells(R, Clm).Address & " is not a date." & vbCr & Dat
            End If
        Next R
    End With
End Sub
Private Function GetDate(Cell As Range, _
                         Dat As Variant) As Boolean

    Dat = Cell.Value
    If IsDate(Dat) Then
        Dat = CLng(Dat)
        GetDate = True
    End If
End Function