Macro para filtrar por rango de fecha

H o l a:

Te anexo la macro para filtrar por fechas

Dim h As Object, ht As Object
'
Private Sub CommandButton4_Click()
'Por.Dante Amor
    TextBox1 = ""
    TextBox2 = ""
    If ComboBox1 = "" Then
        MsgBox "Selecciona el cliente"
        ComboBox1.SetFocus
        Exit Sub
    End If
    '
    u = h.Range("H" & Rows.Count).End(xlUp).Row
    ht.Cells.Clear
    'Encabezados para el filtro
    ht.[C1] = h.[h1]
    ht.[D1] = h.[A1]
    ht.[E1] = h.[A1]
    ht.[F1] = h.[G1]
    '
    'Valores para el filtro
    ht.[A2] = DTPicker1
    ht.[B2] = DTPicker2
    ht.[C2] = ComboBox1
    ht.[D2] = IIf(CheckBox1, "="">=""&RC[-3]", "")
    ht.[E2] = IIf(CheckBox1, "=""<=""&RC[-3]", "")
    '
    'Filtrar
    h.Range("A1:J" & u).AdvancedFilter xlFilterCopy, ht.[C1:F2], ht.[G1]
    'Calcular
    m3 = WorksheetFunction.Sum(ht.Range("P2:P" & u))
    TextBox1 = Format(m3, "#,##0.000")
    ud = WorksheetFunction.Sum(ht.Range("L2:L" & u))
    TextBox2 = Format(ud, "#,##0.00")
End Sub
'
Private Sub UserForm_Activate()
'Por.Dante Amor
    Set h = Sheets("Ruteos 2015")
    Set ht = Sheets("tmp")
    h.Columns("H").Copy Sheets("tmp").[A1]
    u = ht.Range("A" & Rows.Count).End(xlUp).Row
    ht.Range("A1:A" & u).RemoveDuplicates Columns:=1, Header:=xlYes
    With ht.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A2:A" & u): .Header = xlNo: .MatchCase = False
        .Orientation = xlTopToBottom: .SortMethod = xlPinYin: .Apply
    End With
    '
    For i = 2 To ht.Range("A" & Rows.Count).End(xlUp).Row
        ComboBox1.AddItem ht.Cells(i, "A")
    Next
    '
    ComboBox2.AddItem "SMENOR"
    ComboBox2.AddItem "SMAYOR"
End Sub
'
Private Sub CommandButton3_Click()
    Unload Me
End Sub
'
Private Sub ComboBox1_Change()
    limpiar
End Sub
'
Private Sub CheckBox1_Click()
    limpiar
End Sub
Private Sub DTPicker2_Change()
    limpiar
End Sub
Private Sub DTPicker1_Change()
    limpiar
End Sub
Sub limpiar()
    TextBox1 = ""
    TextBox2 = ""
End Sub

':)
':)