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.
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.

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 :
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 :
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
Next
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
Next
i = 0
For i = 1 To 42
If Userform_Date.Controls("Label" & i) = "" Then
Userform_Date.Controls("Label" & i).BackColor = &H808080
End If
Next
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
Next
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)
Else
Userform_Date.ScrollBar1 = Year(CDate(takvim_txt)) - baslangic_yili
Userform_Date.ScrollBar2 = Month(CDate(takvim_txt))
End If
Userform_Date.Show
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).
#If VBA7 Then
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
#Else
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
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
Next
'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
Next
Next

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.

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.Clear
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.AddItem
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 :
Private Sub CommandButton5_Click()
Dim sat As Long, sut As Integer, s2 As Worksheet
Set s2 = Sheets("Sh-2")
s2.Cells.Clear
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, ""
s2.Columns.AutoFit
Set s2 = Nothing
End Sub
2️⃣ “Copy Selected Items To Sh-2” button, it’s codes :
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
Next
s2.Cells.Clear
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
Next
End With
Else
MsgBox "No data has been selected to copy.", vbCritical, ""
Exit Sub
End If
MsgBox "The Selected Data Are Copied.", vbInformation, ""
s2.Select
s2.Columns.AutoFit
Set s2 = Nothing
End Sub