Option Explicit
Sub MoreQuickTest()
MoreQuickIntervallFilter "01.01.2014", "15.01.2014"
End Sub
Private Sub MoreQuickIntervallFilter(dStart As Date, dEnd As Date)
Dim lstCrit As Object, lstDates As Object
Dim dInt As Date
Dim x As Long
Dim arrdates(), arrCrit()
If IsDate(dStart) And IsDate(dEnd) = False Then Exit Sub
If dStart > dEnd Then Exit Sub
If Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)).Cells.Count < 3 Then Exit Sub
With ActiveSheet.UsedRange
.AutoFilter
End With
arrdates = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
Set lstDates = CreateObject("System.Collections.ArrayList")
For x = LBound(arrdates) To UBound(arrdates)
If lstDates.Contains(arrdates(x, 1)) = False Then _
lstDates.Add arrdates(x, 1)
Next x
Set lstCrit = CreateObject("System.Collections.ArrayList")
dInt = dStart
Do
If lstDates.Contains(dInt) = True Then
lstCrit.Add "2"
lstCrit.Add Replace(Format(dInt, "m/d/yyyy"), ".", "/")
End If
dInt = dInt + 1
Loop Until dInt = dEnd + 1
If lstCrit.Count < 2 Then Exit Sub
arrCrit = lstCrit.toarray
With ActiveSheet.UsedRange
.AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=arrCrit
End With
End Sub