Find Data Between Two Dates In Excel VBA

Excel VBA Filtering Between Dates On Worksheet

          In this template ,the records in between two specific dates easily can be filtered using drop-down lists on top side of worksheet.
The drop-down lists were populated with unique date values from oldest to newest using two different methods :

● First way , using Adodb Connection.
● Second way , using Scripting Dictionary object and a user-defined function.

In our template, the dates are listed in column B. Clicking Fill Combo Boxes button on the sheet, dates are filled to the drop-down lists as unique and from oldest to newest. In this first template , we used Adodb.Connection to fill dates as unique into drop-down lists and from oldest to newest. The used VBA codes for this : ⬇

Set con = CreateObject("adodb.connection")
Sheets("Page1").ComboBox1.Clear
Sheets("Page1").ComboBox2.Clear
    #If VBA7 And Win64 Then
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.FullName & ";extended properties=""excel 12.0;hdr=yes"""
    #Else
con.Open "provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=yes"""
    #End If     
Set rs = CreateObject("adodb.recordset")
sorgu = "select Date from [Page1$] group by Date"
rs.Open sorgu, con, 1, 1
While Not rs.EOF
Sheets("Page1").ComboBox1.AddItem VBA.Format(rs("Date").Value, "dd.mm.yyyy")
Sheets("Page1").ComboBox2.AddItem VBA.Format(rs("Date").Value, "dd.mm.yyyy")
rs.movenext
Wend

We have assigned the following procedure to Filter button to filter the data between two dates : ⬇

Public Sub myfilter()
Dim lngStart As Long, lngEnd As Long
   Application.ScreenUpdating = False
   If Sheets("Page1").ComboBox1 = "" Or Sheets("Page1").ComboBox2 = "" Then
   MsgBox "You Must Choose The Start Date And The End Date", vbCritical, ""
   Exit Sub
   End If
   
  lngStart = CDate(Sheets("Page1").ComboBox1) 'Assume this is the start date
  lngEnd = CDate(Sheets("Page1").ComboBox2)   'Assume this is the end date
   If lngStart > lngEnd Then
    MsgBox "The Start Date Can Not Be Bigger Than The End Date.", vbCritical, ""
    Exit Sub
   End If
  Sheets("Page1").Range("B1").AutoFilter field:=2, _
    Criteria1:=">=" & lngStart, Operator:=xlAnd, Criteria2:="<=" & lngEnd
  With Sheets("Page1")
  'The user can see in cell J1 the count of filtered records (rows) between the two dates.     
  .Range("J1").Value = Application.WorksheetFunction.Subtotal(2, .Range("B2:B" & .Rows(.Rows.Count).End(xlUp).Row))
   End With
   Application.ScreenUpdating = True
End Sub 

The filtered data can be copied to FilteredData sheet if it wished.The used VBA codes for this : ⬇

Sub copydata()
Sheets("FilteredData").Cells.Clear
Sheets("Page1").Range("A2:H" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
Destination:=Sheets("FilteredData").Range("A2")
Sheets("FilteredData").Cells.EntireColumn.AutoFit
Sheets("FilteredData").Select
End Sub   

---

Fill Dates To Drop-Down Lists With Scripting Dictionary & Sort Dates From Oldest To Newest In Drop-Down List

For the same template, this time we used the Scripting.Dictionary object to populate the dates as unique values ​​into dropdown lists. Also, we used a user-defined function to sort the dates from oldest to newest. 

To populate drop-down lists with unique values (dates) : ⬇

Sub Fill_DropDownList()
Dim i As Long
Dim MyList As Range
Dim cel As Range
Dim d As Variant, It As Variant, a As Variant
 
Sheets("Page1").ComboBox1.Clear
Set d = CreateObject("Scripting.Dictionary")
Set MyList = Sheets("Page1").Range(Cells(2, 2), Sheets("Page1").Cells(Rows.Count, 2).End(xlUp))
'Create list of unique items using a Dictionary object
On Error Resume Next
For Each It In MyList
d.Add It.Value, It.Value 'Add keys and items
Next
 
'Create an array of unique items
a = d.Items
'Sort the array
Rapidly_Sort a, 0, UBound(a)
Sheets("Page1").ComboBox1.List() = a
 
For s = 0 To Sheets("Page1").ComboBox1.ListCount
Sheets("Page1").ComboBox1.List(s) = Format(Sheets("Page1").ComboBox1.List(s), "dd.mm.yyyy")
Next
Sheets("Page1").ComboBox2.List = Sheets("Page1").ComboBox1.List
End Sub

To sort dates from oldest to newest : ⬇

Sub Rapidly_Sort(ByRef SortArray As Variant, ByVal First As Long, ByVal Last As Long)
Dim dusuk, High As Long
Dim Temp As Variant, List_Separator As Variant
dusuk = First
High = Last
List_Separator = SortArray((First + Last) / 2)
Do
Do While (SortArray(dusuk) < List_Separator)
dusuk = dusuk + 1
Loop
Do While (SortArray(High) > List_Separator)
High = High - 1
Loop
If (dusuk <= High) Then
Temp = SortArray(dusuk)
SortArray(dusuk) = SortArray(High)
SortArray(High) = Temp
dusuk = dusuk + 1
High = High - 1
End If
Loop While (dusuk <= High)
If (First < High) Then Rapidly_Sort SortArray, First, High
If (dusuk < Last) Then Rapidly_Sort SortArray, dusuk, Last
End Sub