Advanced Filtering With Userform

The Items Filtering Based On Dates (First-Last Date)



Ago ,the products  are filled  with unique items into combobox and sorted alfabetically.

For this, the following codes were used:
Private Sub UserForm_Initialize()
Dim ComBoList As Variant, LastRow&, cell As Range
Dim ComBoTemp As Variant, x, j As Long

Application.ScreenUpdating = False
With Worksheets("Sayfa1")
On Error Resume Next
.ShowAllData
Err.Clear
LastRow = .Cells(Rows.Count, 3).End(xlUp).Row
.Range("C2:C" & LastRow).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
ComboBox1.Clear
For Each cell In .Range("C2:C" & LastRow).SpecialCells(12)
ComboBox1.AddItem cell.Value
Next cell
On Error Resume Next
.ShowAllData
Err.Clear
End With

ComBoList = Me.ComboBox1.List
For x = LBound(ComBoList) To UBound(ComBoList) - 1
For j = x + 1 To UBound(ComBoList)
If ComBoList(x, 0) > ComBoList(j, 0) Then
ComBoTemp = ComBoList(x, 0)
ComBoList(x, 0) = ComBoList(j, 0)
ComBoList(j, 0) = ComBoTemp
End If
Next j
Next x

End Sub

       When the dates (first date,last date) are entered in text boxes and if report button is pressed  the userform elongation effect is activated and listbox appears. Products can be filtered on listbox.
Dim tarih1, tarih2 As Date: Dim ara As Range, LastRow As Long
    Dim s1 As Worksheet
    Application.ScreenUpdating = False
    Set s1 = Worksheets("Sayfa1")
    If TextBox1.Value = "" Or TextBox2.Value = "" Then
    MsgBox "Please Enter Date", vbDefaultButton1
    Exit Sub
    End If
    If ComboBox1.Value = "" Then
    MsgBox "Please Choose Product", vbDefaultButton1
    Exit Sub
    End If
    tarih1 = VBA.Format(TextBox1.Value, "dd.mm.yyyy")
    tarih2 = VBA.Format(TextBox2.Value, "dd.mm.yyyy")
 
    ListBox1.Clear
    ListBox1.ColumnCount = 9
    ListBox1.ColumnWidths = "30;170;40;70;60;90;110;50;100"
 
    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) = ara
            ListBox1.List(ListBox1.ListCount - 1, 0) = ara.Offset(0, -1)
            ListBox1.List(ListBox1.ListCount - 1, 1) = ara.Offset(0, 1)
            ListBox1.List(ListBox1.ListCount - 1, 2) = ara.Offset(0, 2)
            ListBox1.List(ListBox1.ListCount - 1, 3) = ara.Offset(0, 3)
            ListBox1.List(ListBox1.ListCount - 1, 4) = VBA.Format(ara.Offset(0, 4), "#,##.00")
            ListBox1.List(ListBox1.ListCount - 1, 5) = ara.Offset(0, 5)
            ListBox1.List(ListBox1.ListCount - 1, 6) = VBA.Format(ara.Offset(0, 6), "#,##.00")
            ListBox1.List(ListBox1.ListCount - 1, 7) = ara.Offset(0, 7)
            ListBox1.List(ListBox1.ListCount - 1, 8) = ara.Offset(0, 8)
         
        End If
 Next ara
 Call uzat
 Application.ScreenUpdating = True

The date userform is used  to enter date automatically into text boxes.


Before listing the filtered data in the listbox, the userform elongation effect increases the height of the userform and the listbox appears.


VBA codes to increase the height of the userform :
Sub uzat()
Dim x, d, yuk, mak As Integer
For x = 1 To 20
DoEvents
If e = 0 Then
d = d + 10
yuk = 242
End If
UserForm1.Height = yuk + d
Next
End Sub

4 comments:

  1. Respected Sir,
    I request to provide The Items Filtering Based On Dates (First-Last Date)templete with VBA code to my email (ylnvprasadrao5@gmail.com) or provide link to download.

    ReplyDelete
  2. type missmatch

    Tarih = CDate("01." & ay & "." & yil)

    can you solve this while i click last date also not show date. please update after upload thank you

    ReplyDelete
  3. type missmatch

    Tarih = CDate("01." & ay & "." & yil)

    can you solve this while i click last date also not show date. please update after upload thank you

    ReplyDelete