Copy only Selected Data

Hi Experts,

I would like to request Experts help modify the attached script. The script is able to copy only unique titles from Column C (Data Sheet) to Detail Sheet. is that possible to modify this script to copy only "Type1" and "Type3" (Column B - Data sheet ) to Detail sheet? Hope Experts will help me create this feature.  

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 allOpen in new window

Data-Copy.xls