Copy Date

Code documentation would help.  At any rate, I believe the line:

            If ka(I, 1) Like "*(*)" Then d = ka(I, 1): GoTo Nxt

Looks for ka(I,1) to be a date with (Tues) or some weekday inside parens to identify that that line in the spreadsheet is a date.

Let's take the same approach with this command:

            If IsDate(ka(I, 1)) Then d = ka(I, 1): GoTo Nxt

It seems to repair the problem!

Here's the revised code:

 

Sub Filter()
    
    Dim k(), ka, I As Long, d As String, n As Long, c As Long
    
    With Worksheets("Data")
        ka = .Range("a6:d" & .Range("a" & .Rows.Count).End(xlUp).Row)
    End With
    
    ReDim k(1 To UBound(ka, 1), 1 To 5)
    
    With CreateObject("scripting.dictionary")
        .comparemode = 1
        For I = 1 To UBound(ka, 1)
            If IsDate(ka(I, 1)) Then d = ka(I, 1): GoTo Nxt ' Like "*(*)" Then
            If Len(ka(I, 3)) Then
                If Not .exists(ka(I, 3)) Then
                    n = n + 1: k(n, 1) = d
                    For c = 1 To UBound(ka, 2)
                        k(n, c + 1) = ka(I, c)
                    Next
                    .Add ka(I, 3), Nothing
                End If
            End If
Nxt:
        Next
    End With
    If n Then
        With Worksheets("Detail")
            Union(.Range("b2").Resize(n), .Range("e2").Resize(n)).NumberFormat = "[h]:mm"
            .Range("a2").Resize(n, UBound(k, 2)) = k
        End With
    End If
    
End Sub

Select all Open in new window

See attached,

Dave
Date-Filter-r1.xls