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

[Santury]

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

[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]

 

[Santury]

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)

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 .

 

[pijaku]

Hi Santury,

Try this :

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

 

[Santury]

Hi,

it totally worked!

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

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

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

 

[pijaku]

Thank you for your Help Pijaku

You're welcome!