Filter Products Between Two Dates With VBA Userform

excel filter between two dates

Suppose we have an Excel sheet where we enter the products we purchased .In some cases, we would like to see which product line we bought between certain dates. For this, we need to filter between two dates. We have created a template that we used the userform to filter between two dates on the worksheet.

excel date userform To select two dates, we used the date userform as an alternative to the VBA calendar-date picker control that opened when we click the textbox. excel userform to enter date

The date userform consists of two scrollbars, two textboxes and labels. On the textboxes, the month and year can be selected using the scrollbars. A label control was added for each day in the userform. Clicking on the labels, the day is selected and the userform is closed.

We added some code to Module1 to add calendar feature to the date userform and enter the selected date into the textbox, and we created classes in Class Module.
Codes of Module1 : vba module

Public days() As New Class1
Public scrl_bar() As New Class1
Public takvim_txt() As New Class1
Public baslangic_yili
Public bitis
Public aktif_txt

Sub clasa_ekle()
baslangic_yili = 1920 'Minimum  Year in Takvim Userform
bitis = 2100          'Maximum Year in Takvim Userform

ReDim Preserve takvim_txt(2)
Set takvim_txt(1).takvim_txt = UserForm1.TextBox1
Set takvim_txt(2).takvim_txt = UserForm1.TextBox2
End Sub

Codes of Class1 : vba class

Public WithEvents days As MSForms.Label
Public WithEvents scrl_bar As MSForms.ScrollBar
Public WithEvents takvim_txt As MSForms.TextBox

Private Sub days_Click()
On Error Resume Next

If days = "" Then Exit Sub
If days.Name = "bugün" Then
aktif_txt.Text = VBA.Format(Now, "dd.mm.yyyy")
ElseIf days <> "" Then
aktif_txt.Text = DateSerial(Userform_Date.ScrollBar1 + baslangic_yili, Userform_Date.ScrollBar2, days)
End If
Unload Userform_Date
End Sub

Private Sub scrl_bar_Change()
    i = 0
    For i = 1 To 42
        Userform_Date.Controls("Label" & i) = ""
        Userform_Date.Controls("Label" & i).BackColor = RGB(255, 255, 204) 'vbCyan
        Userform_Date.Controls("Label" & i).MousePointer = fmMousePointerDefault
yil = Userform_Date.ScrollBar1 + baslangic_yili
ay = Userform_Date.ScrollBar2
Tarih = CDate("01." & ay & "." & yil)
gun = DateSerial(Year(Tarih), Month(Tarih) + 1, 0)

ilk = Application.Weekday(CDate(Tarih), 2)

For x = 1 To Format(gun, "dd")
Userform_Date.Controls("Label" & x + ilk - 1) = x

    i = 0
    For i = 1 To 42
        If Userform_Date.Controls("Label" & i) = "" Then
        Userform_Date.Controls("Label" & i).BackColor = &H808080
        End If
If Year(Now) = Userform_Date.ScrollBar1 + baslangic_yili Then
    If Month(Now) = Userform_Date.ScrollBar2 Then
        For a = 1 To 42
            If Userform_Date.Controls("Label" & a) = CDbl(Day(Now)) Then
            Userform_Date.Controls("Label" & a).BackColor = &HFF&
            End If
    End If
End If

Userform_Date.TextBox1 = yil
Userform_Date.TextBox2 = VBA.Format(Tarih, "mmmm")
End Sub

Private Sub takvim_txt_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
Set aktif_txt = takvim_txt
If takvim_txt = "" Then
Userform_Date.ScrollBar1 = Year(Now) - baslangic_yili
Userform_Date.ScrollBar2 = Month(Now)
Userform_Date.ScrollBar1 = Year(CDate(takvim_txt)) - baslangic_yili
Userform_Date.ScrollBar2 = Month(CDate(takvim_txt))
End If
End Sub

To determine the coordinates (x,y) where the date userform will open, we need to find the position of the cursor. We used the Declare statement and GetCursorPos function to get the position of the cursor.
GetCursorPos function needs a variable as a special data type to hold two integers (x value and y value). vba GetCursorPos

#If VBA7 Then
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
#End If
'We created custom variables that holds two integers

Private Type POINTAPI
   x As Long
   y As Long
End Type
'We dimension the variable that will hold the x and y cursor positions
Dim CurCoord As POINTAPI

Private Sub UserForm_Activate()
'We place the cursor positions into variable CurCoord
GetCursorPos CurCoord
'We determine the top (y value) and left (x value) coordinates where the userform will be displayed.
Me.Top = CurCoord.y * 0.75
Me.Left = CurCoord.x * 0.75
End Sub

vba populate combobox unique sorted values We filled the combobox on the userform with unique and sorted values. For this (to populate combobox unique sorted values), the following VBA codes have been added to the Userform_Initialize procedure :

'Unique Records

For x = 2 To Sheets("Sh-1").Cells(Rows.Count, 3).End(xlUp).Row
If WorksheetFunction.CountIf(Sheets("Sh-1").Range("C2:C" & x), Cells(x, 3)) = 1 Then
ComboBox1.AddItem Sheets("Sh-1").Cells(x, 3).Value
End If
'Alphabetic Order

For a = 0 To ComboBox1.ListCount - 1
  For b = a To ComboBox1.ListCount - 1
        If ComboBox1.List(b) < ComboBox1.List(a) Then
c = ComboBox1.List(a)
    ComboBox1.List(a) = ComboBox1.List(b)
    ComboBox1.List(b) = c
       End If

After selecting first date, second date and product, clicking the Report button , the length of the userform increases and the filtered products are listed on the listbox. vba filter between two dates

Private Sub CommandButton1_Click()
  'Report Button
 Dim tarih1, tarih2 As Date, ara As Range, LastRow As Long
    Dim s1 As Worksheet
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Set s1 = Worksheets("Sh-1")
    If TextBox1.Value = "" Or TextBox2.Value = "" Then
    MsgBox "You need to add the beginning and end dates", vbCritical, ""
    Exit Sub
    End If
    If ComboBox1.Value = "" Then
    MsgBox "Please choose a product from drop-down list", vbDefaultButton1, ""
    Exit Sub
    End If
    Call uzat
  'Calling userform stretch effect.
    tarih1 = VBA.Format(TextBox1.Value, "dd.mm.yyyy")
    tarih2 = VBA.Format(TextBox2.Value, "dd.mm.yyyy")
    ListBox1.ColumnCount = 10
    ListBox1.ColumnWidths = "30;70;140;30;80;65;80;65;60;65"
    LastRow = s1.Range("B" & Rows.Count).End(xlUp).Row
    For Each ara In s1.Range("B2:B" & LastRow)
    If CLng(CDate(ara.Value)) >= CLng(CDate(tarih1)) And _
    CLng(CDate(ara.Value)) <= CLng(CDate(tarih2)) And _
    CStr(ara.Offset(0, 1).Value) = CStr(ComboBox1.Text) Then
     ListBox1.List(ListBox1.ListCount - 1, 1) = VBA.Format(ara, "dd.mm.yyyy")
     ListBox1.List(ListBox1.ListCount - 1, 0) = ara.Offset(0, -1)
     ListBox1.List(ListBox1.ListCount - 1, 2) = ara.Offset(0, 1)
     ListBox1.List(ListBox1.ListCount - 1, 3) = ara.Offset(0, 2)
     ListBox1.List(ListBox1.ListCount - 1, 4) = ara.Offset(0, 3)
     ListBox1.List(ListBox1.ListCount - 1, 5) = VBA.Format(ara.Offset(0, 4), "#,##.00")
     ListBox1.List(ListBox1.ListCount - 1, 6) = ara.Offset(0, 5)
     ListBox1.List(ListBox1.ListCount - 1, 7) = VBA.Format(ara.Offset(0, 6), "#,##.00")
     ListBox1.List(ListBox1.ListCount - 1, 8) = ara.Offset(0, 7)
     ListBox1.List(ListBox1.ListCount - 1, 9) = ara.Offset(0, 8)
     End If
 Next ara
 Set s1 = Nothing
 Application.ScreenUpdating = True
 Application.EnableEvents = True
End Sub

After the filtering event, the selected products with the listbox single select or multiple select, or all listbox items can be copied to “Sh-2” sheet. Two separate buttons have been added into userform for copying from listbox to worksheet :
1️⃣ “Copy All Items To Sh-2” button ,it’s codes : vba copy from listbox to sheet
Private Sub CommandButton5_Click()
Dim sat As Long, sut As Integer, s2 As Worksheet
Set s2 = Sheets("Sh-2")
If ListBox1.ListCount = 0 Then
MsgBox "No data has been selected to copy.", vbExclamation, ""
Exit Sub
End If
sat = ListBox1.ListCount
sut = ListBox1.ColumnCount
s2.Range(s2.Cells(1, 1), s2.Cells(sat, sut)) = ListBox1.List
MsgBox "Data Were Copied.", vbInformation, ""
Set s2 = Nothing
End Sub

2️⃣ “Copy Selected Items To Sh-2” button, it’s codes : vba copy from listbox selected item to sheet
Private Sub CommandButton4_Click()
Dim Lstbx_item, Lstbx_rows, Lstbx_cols As Long
Dim bu As Boolean, Lstbx_loop, Lstbx_copy As Long, s2 As Worksheet
Set s2 = Sheets("Sh-2")
Lstbx_rows = ListBox1.ListCount - 1
Lstbx_cols = ListBox1.ColumnCount - 1
For Lstbx_item = 0 To Lstbx_rows
If ListBox1.Selected(Lstbx_item) = True Then
bu = True
Exit For
End If
If bu = True Then
With s2.Cells(1, 1)
For Lstbx_item = 0 To Lstbx_rows
If ListBox1.Selected(Lstbx_item) = True Then
Lstbx_copy = Lstbx_copy + 1
For Lstbx_loop = 0 To Lstbx_cols
.Cells(Lstbx_copy, Lstbx_loop + 1) = ListBox1.List(Lstbx_item, Lstbx_loop)
Next Lstbx_loop
End If
End With
MsgBox "No data has been selected to copy.", vbCritical, ""
Exit Sub
End If
MsgBox "The Selected Data Are Copied.", vbInformation, ""
Set s2 = Nothing
End Sub

📥 Sample workbook can be downloaded here