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

V

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]
 
Sort by date Sort by votes

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
veyselemre said:
disk.yandex.com.tr

saftawy1 - searchable listbox, 1 textbox, transpose - 12.xlsm

Görüntüle ve Yandex Disk'ten indir
disk.yandex.com.tr disk.yandex.com.tr
Click to expand...
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
veyselemre said:
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
Click to expand...
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
You must log in or register to reply here.

Similar threads

J
  • Solved
Filter a listbox containing 12 columns using a single searchbox
Replies
8
Views
185
Anthony47
A
T
  • Question
Filter data in listbox based on three conditions by selected from combobox
Replies
1
Views
241
tubrak
T
A
  • Question
possible calculation in listbox for debit , credit when search based on textbox ?
Replies
0
Views
310
abdelfattah
A
C
  • Question
A Bookmark to return to the same row when exiting and opening the application
Replies
8
Views
214
Edgar_
Edgar_
M
  • Solved
Search by textbox and criteria combobox and show in listbox
2
Replies
10
Views
503
DanteAmor
DanteAmor

Forum statistics

Threads
1,216,075
Messages
6,128,660
Members
449,462
Latest member
Chislobog

Share this page

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