VBA search in listbox when used combobox and textbox-To be modified

velu888

New Member
Joined
Aug 5, 2022
Messages
7
I have worked to the reference code available at 'Previous Post Thanks a lot for the Code.
It works fine for search as you type. in Textbox1.
I request Codegurus and Codegenies to modify this so that by using two textboxes."From Date" and "To date". based on these two dates, the result of data in between the dates filter should be displayed on the listbox.
Textbox 2 and Textbox3 are dates, I want the dates in between to be displayed in the listbox1

VBA Code:
Private Sub TextBox1_Change()
Dim i As Long, j As Long, k As Long
Dim tx As String
Dim vb, x

tx = Trim(UCase(TextBox1.Text))
Label1.Caption = ""
If tx = "" Then ListBox1.List = va: Exit Sub

x = Application.Match(ComboBox1.Value, Sheets(sList).Rows(1), 0)
If Not IsError(x) Then

    tx = "*" & Replace((tx), " ", "*") & "*"
    ReDim vb(1 To NOC, 1 To UBound(va, 1))
        For i = 1 To UBound(va, 1)
            If UCase(va(i, x)) Like tx Then
                k = k + 1
                For j = 1 To NOC
                    vb(j, k) = va(i, j)
                Next
            End If
        Next
        
        Select Case k
            Case 0
                ListBox1.Clear
            Case 1
                ReDim Preserve vb(1 To NOC, 1 To 15)
                ListBox1.List = Application.Transpose(vb)
            Case Is > 1
                ReDim Preserve vb(1 To NOC, 1 To k)
                ListBox1.List = Application.Transpose(vb)
        End Select
                Label1.Caption = "Found: " & k & " record"
End If

End Sub
[CODE=vba][CODE=vba]
[/CODE]
[/CODE]
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Sir
Thank you for your valuable solution, I tried to use your worked file, it is not functioning well.
I tried the following:
Combobox2 (as From date eg. 04.05.2023) and Combobox3 (as to date eg. 20.05.2023 ), BUT IT IS MISMATCH ERROR


1. Do you still need to search in any column by Textbox1 or you only need to search by 2 dates?
Answer : What you have done is correct, I want to find the data in between two dates selected from the combo boxes. The result should be displayed on Listbox (but it is not)

11.PNG
12.PNG
13.PNG
14.PNG


2. What is your date regional setting, dmy or mdy?
Answer: My regional Setting is English (India), Short date : 05-05-2024,(dd-mm-yyyy)

3. What Excel version do you use?
Answer :Microsoft Office Professional Plus 2016
 
Upvote 0
Try this..
VBA Code:
Option Explicit
Dim adoCon As Object, rs As Object, strSQL$
Private Const NOC As String = 15    'number of columns
Sub connect()
    If adoCon.State = 0 Then
        adoCon.Open "Provider=Microsoft.Ace.Oledb.12.0;Extended Properties='Excel 12.0;HDR=Yes';" & _
                    "Data Source=" & ThisWorkbook.FullName
    End If
End Sub

Private Sub ComboBox1_Change()
    If ComboBox1.Text = "DOB" Then
        ComboBox2.Visible = True
        ComboBox3.Visible = True
        TextBox1.Visible = False
    Else
        ComboBox2.Visible = False
        ComboBox3.Visible = False
        TextBox1.Visible = True
    End If
End Sub

Private Sub UserForm_Terminate()
    If Not adoCon Is Nothing Then
        adoCon.Close
        Set rs = Nothing
        Set adoCon = Nothing
    End If
End Sub
Private Sub UserForm_Initialize()
    Dim adr
    Set adoCon = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Connection")
    ListBox1.ColumnCount = NOC
    ListBox1.ColumnWidths = "250,250,150,250,250,150,250,250,150,250,250,150,250,250,150,250,250,150,250,250,150,250,250,150,250,250,150"
    Label1.Font.Name = "Calibri"
    Label1.Font.Size = 12

    With Sheets("Sheet1")
        ComboBox1.List = Application.Transpose(.Range("A1").Resize(1, NOC).Value)
        adr = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).Resize(, NOC).Address(0, 0)

        strSQL = "SELECT FORMAT(DOB, 'dd-mm-yyyy') FROM [" & .Name & "$" & adr & "] WHERE NOT COMPANY IS NULL "
        If adoCon.State = 0 Then Call connect
        Set rs = adoCon.Execute(strSQL)
        ComboBox2.Column = rs.getrows
        rs.movefirst
        ComboBox3.Column = rs.getrows
        rs.Close

        strSQL = "SELECT COMPANY,CITY,CONTACT,Namu,FORMAT(DOB, 'dd-mm-yyyy'),GEN," & _
                 "PH,EMAIL,DECLAR,DEPT,SECTIO,BUYER,INSURE,AGENCY,CENTRE FROM " & _
                 "[" & .Name & "$" & adr & "] WHERE NOT COMPANY IS NULL "
        Call addListBox(strSQL$)
    End With
End Sub
Sub addListBox(strSQL_$)
    If adoCon.State = 0 Then Call connect
    Set rs = adoCon.Execute(strSQL_)
    If Not (rs.EOF Or rs.bof) Then
        ListBox1.Column = rs.getrows
        Label1.Caption = "Found: " & ListBox1.ListCount & " record."
    End If
    rs.Close
End Sub
Private Sub TextBox1_Change()
    If ComboBox1.Text <> "DOB" And TextBox1.Text <> "" Then
        Call addListBox(strSQL & " AND " & ComboBox1.Text & " LIKE '%" & Replace(TextBox1.Text, " ", "%") & "%'")
    Else
        Call addListBox(strSQL)
    End If
End Sub
Private Sub ComboBox2_Change()
    If ComboBox1.Text = "DOB" And ComboBox2.Text <> "" And ComboBox3.Text <> "" Then Call dateSql
End Sub
Private Sub ComboBox3_Change()
    If ComboBox1.Text = "DOB" And ComboBox2.Text <> "" And ComboBox3.Text <> "" Then Call dateSql
End Sub
Sub dateSql()
    If IsDate(CDate(ComboBox2.Text)) And IsDate(CDate(ComboBox3.Text)) Then
        Dim tar1, tar2
        tar1 = CDate(ComboBox2.Text)
        tar2 = CDate(ComboBox3.Text)
        If tar2 >= tar1 Then
            Call addListBox(strSQL & " AND DOB>=" & Format(tar1, "\#mm\/dd\/yyyy\#") & " AND DOB<=" & Format(tar2, "\#mm\/dd\/yyyy\#"))
        Else
            Call addListBox(strSQL)
        End If
    End If
End Sub
 
Upvote 0
Solution
Try this..
VBA Code:
Option Explicit
Dim adoCon As Object, rs As Object, strSQL$
Private Const NOC As String = 15    'number of columns
Sub connect()
    If adoCon.State = 0 Then
        adoCon.Open "Provider=Microsoft.Ace.Oledb.12.0;Extended Properties='Excel 12.0;HDR=Yes';" & _
                    "Data Source=" & ThisWorkbook.FullName
    End If
End Sub

Private Sub ComboBox1_Change()
    If ComboBox1.Text = "DOB" Then
        ComboBox2.Visible = True
        ComboBox3.Visible = True
        TextBox1.Visible = False
    Else
        ComboBox2.Visible = False
        ComboBox3.Visible = False
        TextBox1.Visible = True
    End If
End Sub

Private Sub UserForm_Terminate()
    If Not adoCon Is Nothing Then
        adoCon.Close
        Set rs = Nothing
        Set adoCon = Nothing
    End If
End Sub
Private Sub UserForm_Initialize()
    Dim adr
    Set adoCon = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Connection")
    ListBox1.ColumnCount = NOC
    ListBox1.ColumnWidths = "250,250,150,250,250,150,250,250,150,250,250,150,250,250,150,250,250,150,250,250,150,250,250,150,250,250,150"
    Label1.Font.Name = "Calibri"
    Label1.Font.Size = 12

    With Sheets("Sheet1")
        ComboBox1.List = Application.Transpose(.Range("A1").Resize(1, NOC).Value)
        adr = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).Resize(, NOC).Address(0, 0)

        strSQL = "SELECT FORMAT(DOB, 'dd-mm-yyyy') FROM [" & .Name & "$" & adr & "] WHERE NOT COMPANY IS NULL "
        If adoCon.State = 0 Then Call connect
        Set rs = adoCon.Execute(strSQL)
        ComboBox2.Column = rs.getrows
        rs.movefirst
        ComboBox3.Column = rs.getrows
        rs.Close

        strSQL = "SELECT COMPANY,CITY,CONTACT,Namu,FORMAT(DOB, 'dd-mm-yyyy'),GEN," & _
                 "PH,EMAIL,DECLAR,DEPT,SECTIO,BUYER,INSURE,AGENCY,CENTRE FROM " & _
                 "[" & .Name & "$" & adr & "] WHERE NOT COMPANY IS NULL "
        Call addListBox(strSQL$)
    End With
End Sub
Sub addListBox(strSQL_$)
    If adoCon.State = 0 Then Call connect
    Set rs = adoCon.Execute(strSQL_)
    If Not (rs.EOF Or rs.bof) Then
        ListBox1.Column = rs.getrows
        Label1.Caption = "Found: " & ListBox1.ListCount & " record."
    End If
    rs.Close
End Sub
Private Sub TextBox1_Change()
    If ComboBox1.Text <> "DOB" And TextBox1.Text <> "" Then
        Call addListBox(strSQL & " AND " & ComboBox1.Text & " LIKE '%" & Replace(TextBox1.Text, " ", "%") & "%'")
    Else
        Call addListBox(strSQL)
    End If
End Sub
Private Sub ComboBox2_Change()
    If ComboBox1.Text = "DOB" And ComboBox2.Text <> "" And ComboBox3.Text <> "" Then Call dateSql
End Sub
Private Sub ComboBox3_Change()
    If ComboBox1.Text = "DOB" And ComboBox2.Text <> "" And ComboBox3.Text <> "" Then Call dateSql
End Sub
Sub dateSql()
    If IsDate(CDate(ComboBox2.Text)) And IsDate(CDate(ComboBox3.Text)) Then
        Dim tar1, tar2
        tar1 = CDate(ComboBox2.Text)
        tar2 = CDate(ComboBox3.Text)
        If tar2 >= tar1 Then
            Call addListBox(strSQL & " AND DOB>=" & Format(tar1, "\#mm\/dd\/yyyy\#") & " AND DOB<=" & Format(tar2, "\#mm\/dd\/yyyy\#"))
        Else
            Call addListBox(strSQL)
        End If
    End If
End Sub
Thank You very much Mr veyselemre, a great response and a solution provider. Glad you helped me and thank you once more.
It is working now as per my expectations. Below is the screen shot.
1714915686518.png
 
Upvote 0

Forum statistics

Threads
1,224,813
Messages
6,181,118
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top