Dynamic Search bar in excel from partial input in an other Sheet

Santury

New Member
Joined
Jan 26, 2018
Messages
3
Hi everybody,

I'm working in Human Ressources and I'm creating a file with a lot of datas on our employees.

I have a Workbook with several Worksheet and i'd like to make a dynamic Search bar with a dynamic list box to display results,

this "search bar" would've to fill the "result box" in sheet1 with data provided by a single column in sheet2.

This code below worked pretty well on a single sheet but i haven't managed yet to do that with several sheets...
I wouldn't need the colours anymore as the datas are in another sheet but that's just an example.

Could you help me please?

Merci à tous et toutes,

Santury from France :)

Code:
[COLOR=#000080][B]Option[/B][/COLOR] Compare Text
 
[COLOR=#000080][B]Private[/B][/COLOR] [COLOR=#000080][B]Sub[/B][/COLOR] TextBox1_Change() [COLOR=#008000]
[/COLOR]    
    Application.ScreenUpdating = [COLOR=#000080][B]False[/B][/COLOR]
 
    Range([COLOR=#800000]"A2:A24"[/COLOR]).Interior.ColorIndex = 2 [COLOR=#008000]
[/COLOR]    ListBox1.Clear [COLOR=#008000]
[/COLOR]    
    [COLOR=#000080][B]If[/B][/COLOR] TextBox1 <> [COLOR=#800000]""[/COLOR] [COLOR=#000080][B]Then[/B][/COLOR]
        [COLOR=#000080][B]For[/B][/COLOR] ligne = 2 [COLOR=#000080][B]To[/B][/COLOR] 24
            [COLOR=#000080][B]If[/B][/COLOR] Cells(ligne, 1) [COLOR=#000080][B]Like[/B][/COLOR] [COLOR=#800000]"*"[/COLOR] & TextBox1 & [COLOR=#800000]"*"[/COLOR] [COLOR=#000080][B]Then[/B][/COLOR]
                Cells(ligne, 1).Interior.ColorIndex = 43 [COLOR=#008000]
[/COLOR]                ListBox1.AddItem Cells(ligne, 1)[COLOR=#008000]
[/COLOR]            [COLOR=#000080][B]End[/B][/COLOR] [COLOR=#000080][B]If[/B][/COLOR]
        [COLOR=#000080][B]Next[/B][/COLOR]
    [COLOR=#000080][B]End[/B][/COLOR] [COLOR=#000080][B]If[/B][/COLOR]
 
[COLOR=#000080][B]End[/B][/COLOR] [COLOR=#000080][B]Sub[/B][/COLOR]
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Hi,

i'm still stuck with this code, and i have a 1004 Error

I've 2 sheets, 2018 (sheet1 with the textbox and listbox) and "Formules" (sheet2, containing datas)

Code:
Private Sub TextBox1_Change()
    
    Application.ScreenUpdating = False
    
 If Sheets("2018").TextBox1 <> "" Then
      If Sheets("FORMULES").Range("A:A").Cells(ligne, 1) Like "*" & Sheets("2018").TextBox1 & "*" Then
                Sheets("2018").ListBox1.AddItem Cells(ligne, 1)
            End If
        End If
End Sub

Do you have any idea? thank you .
 
Upvote 0
Hi Santury,

Try this :
Code:
Private Sub TextBox1_Change()Dim ligne As Long, DL As Long
    Application.ScreenUpdating = False
    DL = Sheets("FORMULES").Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
    If Sheets("2018").TextBox1 <> "" Then
        Sheets("2018").ListBox1.Clear
        For ligne = 1 To DL
            If Sheets("FORMULES").Cells(ligne, 1) Like "*" & Sheets("2018").TextBox1 & "*" Then
                Sheets("2018").ListBox1.AddItem Sheets("FORMULES").Cells(ligne, 1)
            End If
        Next ligne
    End If
End Sub
 
Upvote 0
Hi,

it totally worked!

I've Kept the Option Compare Text and added ListBox1.Clear + a copy script to prevent mistakes :)



Code:
Option Compare Text


Private Sub TextBox1_Change()
Dim ligne As Long, DL As Long
    Application.ScreenUpdating = False
    DL = Sheets("FORMULES").Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
    ListBox1.Clear
   If TextBox1 <> "" Then
    ListBox1.Clear
        For ligne = 6 To DL
            If Sheets("FORMULES").Cells(ligne, 1) Like "*" & TextBox1 & "*" Then
                ListBox1.AddItem Sheets("FORMULES").Cells(ligne, 1)
            End If
        Next ligne
    End If
End Sub

Code:
Private Sub ListBox1_Click()
Dim MyData As New DataObject
 Set MyData = New DataObject
  MyData.SetText ListBox1.Value
    MyData.PutInClipboard
End Sub

Thank you for your Help Pijaku :)
 
Upvote 0

Forum statistics

Threads
1,213,561
Messages
6,114,317
Members
448,564
Latest member
ED38

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