looking for macro to search workbook

S

Stevesmail

New Member
Joined
May 3, 2021
Messages
11
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
Hello

I thought I would ask you good people a question on a workbook I'm developing for my place of employment. We have many SDS sheets for the many chemicals we have at the workplace. The company didn't have very good organization with the sheets which can be a safety and fire hazard because of not finding SDS in good time.

I offered to organize these and so I'm developing an excel workbook. In the workbook, I'm going to have several tabs. These SDS sheets will be organized based on manufacturer of the chemicals. I have column A with the mfg name, 2nd column has chemical name and the last column will have a hyperlink to the SDS file on the company server. The tabs will be set up as A, B, C, etc

What I've been looking for is a Macro that can do a search in the whole workbook for the manufacture name or chemical name which is in the first 2 columns. First tab will the search page where I'll put a search button and clear button on the page. What I'm wanting is for a person to either look for the SDS by clicking on the tab corresponding to the manufacturer and scroll through the manufacturers to find what they are looking for or go to the search page and type in the manufacture name or chemical name and either go to the cell automatically from the search in the workbook or bring a copy of the searched line onto the search page which will be faster to access the SDS. I haven't found a macro to do what I need it to do yet and thought someone here could guide me in the right direction. Thanks
 
Sort by date Sort by votes
​
As I'm very beginner to guess anything - the reason why I'm not on any mind readers forum ! - I can't do nothing without​
the necessary yet expected in the initial post whatever the Excel forum : a complete crystal clear elaboration & an attachment …​
 
Upvote 0

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
I am working on a design but not ready to present it yet. A question, do you use a dropdown list to select the company to search for or just trust the user to type correctly?
 
Upvote 0
vw412 said:
I am working on a design but not ready to present it yet. A question, do you use a dropdown list to select the company to search for or just trust the user to type correctly?
Click to expand...
Thanks vw412. I didn't think of a drop-down. My thought was a search box but a drop down is a great idea. A drop down might be faster. An sds is an important emergency document. If someone got a chemical in their eyes or on their skin, time is of the essence to bring up the document for medical treatment. Also in case of fire, quick access to the document for the fire department would be important
 
Upvote 0
I was thinking along the same lines. Depending on user typing accuracy is a sure way to introduce confusion. I think a dynamic dropdown list is doable.
 
Upvote 0
VBA Code: 
Function Sheet_Search(SHEET as Worksheet, _
                  ByVal Rng, LookFor, Answer_Row, _
                  Optional Answer_Col, _
                  Optional LookAt As XlLookAt = xlWhole, _
                  Optional Case_Arg As Boolean = False) As Boolean
  
    ' Lookup a String in a Sheet and return its address in ROW and COL.
    ' Note: The Sheet must be in the currently opened Workbook.
    ' Note: LookAt can have values "xlPart" or "xlWhole".
    ' 12/22/10 Replaced Find_Sub. WML
    ' 12/22/10 Replaced xlLookAts Enum. WML
    ' 7/24/15 Made all args after LOOKFOR optional. WML
    ' 3/28/18 Added call to "Range_Check".  WML
    ' 9/4/19 Changed "Case_Arg" option to False. WML
    ' 1/15/20 Added check to see if finding the same row, in which case it's an error. WML
    ' 10/1/20 Revisit. WML
    ' 1/8/21 New code in OS. WML
    ' 5/5/21 Renamed from "Sheet_Search". WML
    
    Prog = "Sheet_Search"
    
    With SHEET.Range(Rng)
        Set HOLD = .Find( _
                        What:=LookFor, _
                        LookIn:=xlValues, _
                        LookAt:=LookAt, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=Case_Arg, _
                        SearchFormat:=False)
    End With
            
    If HOLD Is Nothing Then
        Sheet_Search = False
    Else
        ' Extra test to be sure
        Answer_Row = HOLD.Row
        Answer_Col = HOLD.Column        ' <-- Corrected 5/14/20
        Sheet_Search = True
    End If
    
End Function ' Sheet_Search
 
Upvote 0
Stevesmail, I have something I think you will like. Two sets of code follow.

the first should go into a standard Module:
VBA Code: 
Option Explicit

Global CompaniesRS As Recordset, ProductsRS As Recordset, LinkToSheet As String
' CompaniesRS is recordset with fields: Key=CompanyName,WSADDR=WSAddress
' PeoductsRS is recordset with entries: Key=Product,WSADDR=WSAddress
Sub MakeRecordsets()
  Dim ws As Worksheet, SheetLastRow As Long, SheetRow As Long
  Set CompaniesRS = New Recordset
  With CompaniesRS
    .Fields.Append "Key", adChar, 256
    .Fields.Append "WSADDR", adChar, 120
    .Open
  End With
  Set ProductsRS = New Recordset
  With ProductsRS
    .Fields.Append "Key", adChar, 256
    .Fields.Append "WSADDR", adChar, 120
    .Open
  End With
  For Each ws In ThisWorkbook.Worksheets
    If Not CStr(ws.Name) = "Search" Then
      SheetLastRow = LastRow(ws)
      For SheetRow = 2 To SheetLastRow
        If ws.Cells(SheetRow, 1).Value <> "" Then
          With CompaniesRS
            .AddNew
            .Fields("Key") = CStr(ws.Cells(SheetRow, 1).Value)
            .Fields("WSADDR") = CStr(ws.Name) & "!" & ws.Cells(SheetRow, 1).Address
          End With
        End If
        If ws.Cells(SheetRow, 2).Value <> "" Then
          With ProductsRS
            .AddNew
            .Fields("Key") = CStr(ws.Cells(SheetRow, 2).Value)
            .Fields("WSADDR") = CStr(ws.Name) & "!" & ws.Cells(SheetRow, 2).Address
          End With
        End If
      Next SheetRow
    End If
  Next ws
  ProductsRS.Update
  CompaniesRS.Update
End Sub

Function LastRow(Sh As Worksheet) As Variant
  On Error Resume Next
  LastRow = Sh.Cells.Find(What:="*", _
                          After:=Sh.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
  On Error GoTo 0
End Function

the second should go into the Search tab code page:
VBA Code: 
Option Explicit

Private Sub ListBox1_Click()
  Dim x
  CompaniesRS.Find "Key='" & ListBox1.Text & "'", , adSearchForward, adBookmarkFirst
  LinkToSheet = CompaniesRS.Fields("WSADDR")
  x = Split(LinkToSheet, "!")
  Application.Goto reference:=Sheets(x(0)).Range(x(1))
  ' return to search tab with mouse or F5 goto menu
End Sub

Private Sub ListBox2_Click()
  Dim x
  ProductsRS.Find "Key='" & ListBox2.Text & "'", , adSearchForward, adBookmarkFirst
  LinkToSheet = ProductsRS.Fields("WSADDR")
  x = Split(LinkToSheet, "!")
  Application.Goto reference:=Sheets(x(0)).Range(x(1))
  ' return to search tab with mouse or F5 goto menu
End Sub

Private Sub TextBox1_Change()
  If Len(TextBox1.Text) > 0 Then
    If TextBox1.Text = "*" Then
      CompaniesRS.Filter = 0
    Else
      CompaniesRS.Filter = "Key LIKE '" & TextBox1.Text & "*'"
    End If
    ListBox1.Clear
    With CompaniesRS
      If .RecordCount > 0 Then
        .MoveFirst
        Do Until .EOF
          ListBox1.AddItem .Fields("Key")
          .MoveNext
        Loop
      End If
    End With
  Else
    ListBox1.Clear
    CompaniesRS.Filter = 0
  End If
End Sub

Private Sub TextBox1_GotFocus()
  ListBox1.Clear
  If CompaniesRS Is Nothing Then
    MakeRecordsets
  End If
  With CompaniesRS
    .Filter = 0
    If .RecordCount > 0 Then
      .MoveFirst
      Do Until .EOF
        ListBox1.AddItem .Fields("Key")
        .MoveNext
      Loop
    End If
  End With
End Sub

Private Sub TextBox1_LostFocus()
  ListBox1.Clear
  TextBox1.Text = ""
End Sub

Private Sub TextBox2_Change()
  If Len(TextBox2.Text) > 0 Then
    If TextBox2.Text = "*" Then
      ProductsRS.Filter = 0
    Else
      ProductsRS.Filter = "Key LIKE '" & TextBox2.Text & "*'"
    End If
    ListBox2.Clear
    With ProductsRS
      If .RecordCount > 0 Then
        .MoveFirst
        Do Until .EOF
          ListBox2.AddItem .Fields("Key")
          .MoveNext
        Loop
      End If
    End With
  Else
    ListBox2.Clear
    ProductsRS.Filter = 0
  End If
End Sub

Private Sub TextBox2_GotFocus()
  ListBox2.Clear
  If ProductsRS Is Nothing Then
    MakeRecordsets
  End If
  With ProductsRS
    .Filter = 0
    If .RecordCount > 0 Then
      .MoveFirst
      Do Until .EOF
        ListBox2.AddItem .Fields("Key")
        .MoveNext
      Loop
    End If
  End With
End Sub

Private Sub TextBox2_LostFocus()
  ListBox2.Clear
  TextBox2.Text = ""
End Sub

Private Sub Worksheet_Activate()
  ListBox1.Clear
  ListBox2.Clear
  TextBox1.Text = ""
  TextBox2.Text = ""
  MakeRecordsets
End Sub

I don't have time right now to describe all this but am willing to talk you through it so you can understand what it is doing and why I designed it this way. Just prompt me with questions here.
 
Upvote 0
vw412 said:
Stevesmail, I have something I think you will like. Two sets of code follow.

the first should go into a standard Module:
VBA Code: 
Option Explicit

Global CompaniesRS As Recordset, ProductsRS As Recordset, LinkToSheet As String
' CompaniesRS is recordset with fields: Key=CompanyName,WSADDR=WSAddress
' PeoductsRS is recordset with entries: Key=Product,WSADDR=WSAddress
Sub MakeRecordsets()
  Dim ws As Worksheet, SheetLastRow As Long, SheetRow As Long
  Set CompaniesRS = New Recordset
  With CompaniesRS
    .Fields.Append "Key", adChar, 256
    .Fields.Append "WSADDR", adChar, 120
    .Open
  End With
  Set ProductsRS = New Recordset
  With ProductsRS
    .Fields.Append "Key", adChar, 256
    .Fields.Append "WSADDR", adChar, 120
    .Open
  End With
  For Each ws In ThisWorkbook.Worksheets
    If Not CStr(ws.Name) = "Search" Then
      SheetLastRow = LastRow(ws)
      For SheetRow = 2 To SheetLastRow
        If ws.Cells(SheetRow, 1).Value <> "" Then
          With CompaniesRS
            .AddNew
            .Fields("Key") = CStr(ws.Cells(SheetRow, 1).Value)
            .Fields("WSADDR") = CStr(ws.Name) & "!" & ws.Cells(SheetRow, 1).Address
          End With
        End If
        If ws.Cells(SheetRow, 2).Value <> "" Then
          With ProductsRS
            .AddNew
            .Fields("Key") = CStr(ws.Cells(SheetRow, 2).Value)
            .Fields("WSADDR") = CStr(ws.Name) & "!" & ws.Cells(SheetRow, 2).Address
          End With
        End If
      Next SheetRow
    End If
  Next ws
  ProductsRS.Update
  CompaniesRS.Update
End Sub

Function LastRow(Sh As Worksheet) As Variant
  On Error Resume Next
  LastRow = Sh.Cells.Find(What:="*", _
                          After:=Sh.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
  On Error GoTo 0
End Function

the second should go into the Search tab code page:
VBA Code: 
Option Explicit

Private Sub ListBox1_Click()
  Dim x
  CompaniesRS.Find "Key='" & ListBox1.Text & "'", , adSearchForward, adBookmarkFirst
  LinkToSheet = CompaniesRS.Fields("WSADDR")
  x = Split(LinkToSheet, "!")
  Application.Goto reference:=Sheets(x(0)).Range(x(1))
  ' return to search tab with mouse or F5 goto menu
End Sub

Private Sub ListBox2_Click()
  Dim x
  ProductsRS.Find "Key='" & ListBox2.Text & "'", , adSearchForward, adBookmarkFirst
  LinkToSheet = ProductsRS.Fields("WSADDR")
  x = Split(LinkToSheet, "!")
  Application.Goto reference:=Sheets(x(0)).Range(x(1))
  ' return to search tab with mouse or F5 goto menu
End Sub

Private Sub TextBox1_Change()
  If Len(TextBox1.Text) > 0 Then
    If TextBox1.Text = "*" Then
      CompaniesRS.Filter = 0
    Else
      CompaniesRS.Filter = "Key LIKE '" & TextBox1.Text & "*'"
    End If
    ListBox1.Clear
    With CompaniesRS
      If .RecordCount > 0 Then
        .MoveFirst
        Do Until .EOF
          ListBox1.AddItem .Fields("Key")
          .MoveNext
        Loop
      End If
    End With
  Else
    ListBox1.Clear
    CompaniesRS.Filter = 0
  End If
End Sub

Private Sub TextBox1_GotFocus()
  ListBox1.Clear
  If CompaniesRS Is Nothing Then
    MakeRecordsets
  End If
  With CompaniesRS
    .Filter = 0
    If .RecordCount > 0 Then
      .MoveFirst
      Do Until .EOF
        ListBox1.AddItem .Fields("Key")
        .MoveNext
      Loop
    End If
  End With
End Sub

Private Sub TextBox1_LostFocus()
  ListBox1.Clear
  TextBox1.Text = ""
End Sub

Private Sub TextBox2_Change()
  If Len(TextBox2.Text) > 0 Then
    If TextBox2.Text = "*" Then
      ProductsRS.Filter = 0
    Else
      ProductsRS.Filter = "Key LIKE '" & TextBox2.Text & "*'"
    End If
    ListBox2.Clear
    With ProductsRS
      If .RecordCount > 0 Then
        .MoveFirst
        Do Until .EOF
          ListBox2.AddItem .Fields("Key")
          .MoveNext
        Loop
      End If
    End With
  Else
    ListBox2.Clear
    ProductsRS.Filter = 0
  End If
End Sub

Private Sub TextBox2_GotFocus()
  ListBox2.Clear
  If ProductsRS Is Nothing Then
    MakeRecordsets
  End If
  With ProductsRS
    .Filter = 0
    If .RecordCount > 0 Then
      .MoveFirst
      Do Until .EOF
        ListBox2.AddItem .Fields("Key")
        .MoveNext
      Loop
    End If
  End With
End Sub

Private Sub TextBox2_LostFocus()
  ListBox2.Clear
  TextBox2.Text = ""
End Sub

Private Sub Worksheet_Activate()
  ListBox1.Clear
  ListBox2.Clear
  TextBox1.Text = ""
  TextBox2.Text = ""
  MakeRecordsets
End Sub

I don't have time right now to describe all this but am willing to talk you through it so you can understand what it is doing and why I designed it this way. Just prompt me with questions here.
Click to expand...
Good morning vw412. Thanks for all of your help. I'll check these out within the next couple days and let you know how they work. Really appreciate your time and effort
 
Upvote 0
Stevesmail, I have something I think you will like. Two sets of code follow.

the first should go into a standard Module:
VBA Code: 
Option Explicit

Global CompaniesRS As Recordset, ProductsRS As Recordset, LinkToSheet As String
' CompaniesRS is recordset with fields: Key=CompanyName,WSADDR=WSAddress
' PeoductsRS is recordset with entries: Key=Product,WSADDR=WSAddress
Sub MakeRecordsets()
  Dim ws As Worksheet, SheetLastRow As Long, SheetRow As Long
  Set CompaniesRS = New Recordset
  With CompaniesRS
    .Fields.Append "Key", adChar, 256
    .Fields.Append "WSADDR", adChar, 120
    .Open
  End With
  Set ProductsRS = New Recordset
  With ProductsRS
    .Fields.Append "Key", adChar, 256
    .Fields.Append "WSADDR", adChar, 120
    .Open
  End With
  For Each ws In ThisWorkbook.Worksheets
    If Not CStr(ws.Name) = "Search" Then
      SheetLastRow = LastRow(ws)
      For SheetRow = 2 To SheetLastRow
        If ws.Cells(SheetRow, 1).Value <> "" Then
          With CompaniesRS
            .AddNew
            .Fields("Key") = CStr(ws.Cells(SheetRow, 1).Value)
            .Fields("WSADDR") = CStr(ws.Name) & "!" & ws.Cells(SheetRow, 1).Address
          End With
        End If
        If ws.Cells(SheetRow, 2).Value <> "" Then
          With ProductsRS
            .AddNew
            .Fields("Key") = CStr(ws.Cells(SheetRow, 2).Value)
            .Fields("WSADDR") = CStr(ws.Name) & "!" & ws.Cells(SheetRow, 2).Address
          End With
        End If
      Next SheetRow
    End If
  Next ws
  ProductsRS.Update
  CompaniesRS.Update
End Sub

Function LastRow(Sh As Worksheet) As Variant
  On Error Resume Next
  LastRow = Sh.Cells.Find(What:="*", _
                          After:=Sh.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
  On Error GoTo 0
End Function

the second should go into the Search tab code page:
VBA Code: 
Option Explicit

Private Sub ListBox1_Click()
  Dim x
  CompaniesRS.Find "Key='" & ListBox1.Text & "'", , adSearchForward, adBookmarkFirst
  LinkToSheet = CompaniesRS.Fields("WSADDR")
  x = Split(LinkToSheet, "!")
  Application.Goto reference:=Sheets(x(0)).Range(x(1))
  ' return to search tab with mouse or F5 goto menu
End Sub

Private Sub ListBox2_Click()
  Dim x
  ProductsRS.Find "Key='" & ListBox2.Text & "'", , adSearchForward, adBookmarkFirst
  LinkToSheet = ProductsRS.Fields("WSADDR")
  x = Split(LinkToSheet, "!")
  Application.Goto reference:=Sheets(x(0)).Range(x(1))
  ' return to search tab with mouse or F5 goto menu
End Sub

Private Sub TextBox1_Change()
  If Len(TextBox1.Text) > 0 Then
    If TextBox1.Text = "*" Then
      CompaniesRS.Filter = 0
    Else
      CompaniesRS.Filter = "Key LIKE '" & TextBox1.Text & "*'"
    End If
    ListBox1.Clear
    With CompaniesRS
      If .RecordCount > 0 Then
        .MoveFirst
        Do Until .EOF
          ListBox1.AddItem .Fields("Key")
          .MoveNext
        Loop
      End If
    End With
  Else
    ListBox1.Clear
    CompaniesRS.Filter = 0
  End If
End Sub

Private Sub TextBox1_GotFocus()
  ListBox1.Clear
  If CompaniesRS Is Nothing Then
    MakeRecordsets
  End If
  With CompaniesRS
    .Filter = 0
    If .RecordCount > 0 Then
      .MoveFirst
      Do Until .EOF
        ListBox1.AddItem .Fields("Key")
        .MoveNext
      Loop
    End If
  End With
End Sub

Private Sub TextBox1_LostFocus()
  ListBox1.Clear
  TextBox1.Text = ""
End Sub

Private Sub TextBox2_Change()
  If Len(TextBox2.Text) > 0 Then
    If TextBox2.Text = "*" Then
      ProductsRS.Filter = 0
    Else
      ProductsRS.Filter = "Key LIKE '" & TextBox2.Text & "*'"
    End If
    ListBox2.Clear
    With ProductsRS
      If .RecordCount > 0 Then
        .MoveFirst
        Do Until .EOF
          ListBox2.AddItem .Fields("Key")
          .MoveNext
        Loop
      End If
    End With
  Else
    ListBox2.Clear
    ProductsRS.Filter = 0
  End If
End Sub

Private Sub TextBox2_GotFocus()
  ListBox2.Clear
  If ProductsRS Is Nothing Then
    MakeRecordsets
  End If
  With ProductsRS
    .Filter = 0
    If .RecordCount > 0 Then
      .MoveFirst
      Do Until .EOF
        ListBox2.AddItem .Fields("Key")
        .MoveNext
      Loop
    End If
  End With
End Sub

Private Sub TextBox2_LostFocus()
  ListBox2.Clear
  TextBox2.Text = ""
End Sub

Private Sub Worksheet_Activate()
  ListBox1.Clear
  ListBox2.Clear
  TextBox1.Text = ""
  TextBox2.Text = ""
  MakeRecordsets
End Sub

I don't have time right now to describe all this but am willing to talk you through it so you can understand what it is doing and why I designed it this way. Just pr
Stevesmail said:
Good morning vw412. Thanks for all of your help. I'll check these out within the next couple days and let you know how they work. Really appreciate your time and effort
Click to expand...
Something I need to mention. You will need to configure a reference to Microsoft ActiveX Data Objects Recordset Library. Open the VBE, click Tools/References then search for it (may be more than one I used v2.8) and click the checkbox in front of it. Then click OK. Again, as above, don't hesitate to ask questions.
 
Upvote 0
vw412 said:
Stevesmail, I have something I think you will like. Two sets of code follow.

the first should go into a standard Module:
VBA Code: 
Option Explicit

Global CompaniesRS As Recordset, ProductsRS As Recordset, LinkToSheet As String
' CompaniesRS is recordset with fields: Key=CompanyName,WSADDR=WSAddress
' PeoductsRS is recordset with entries: Key=Product,WSADDR=WSAddress
Sub MakeRecordsets()
  Dim ws As Worksheet, SheetLastRow As Long, SheetRow As Long
  Set CompaniesRS = New Recordset
  With CompaniesRS
    .Fields.Append "Key", adChar, 256
    .Fields.Append "WSADDR", adChar, 120
    .Open
  End With
  Set ProductsRS = New Recordset
  With ProductsRS
    .Fields.Append "Key", adChar, 256
    .Fields.Append "WSADDR", adChar, 120
    .Open
  End With
  For Each ws In ThisWorkbook.Worksheets
    If Not CStr(ws.Name) = "Search" Then
      SheetLastRow = LastRow(ws)
      For SheetRow = 2 To SheetLastRow
        If ws.Cells(SheetRow, 1).Value <> "" Then
          With CompaniesRS
            .AddNew
            .Fields("Key") = CStr(ws.Cells(SheetRow, 1).Value)
            .Fields("WSADDR") = CStr(ws.Name) & "!" & ws.Cells(SheetRow, 1).Address
          End With
        End If
        If ws.Cells(SheetRow, 2).Value <> "" Then
          With ProductsRS
            .AddNew
            .Fields("Key") = CStr(ws.Cells(SheetRow, 2).Value)
            .Fields("WSADDR") = CStr(ws.Name) & "!" & ws.Cells(SheetRow, 2).Address
          End With
        End If
      Next SheetRow
    End If
  Next ws
  ProductsRS.Update
  CompaniesRS.Update
End Sub

Function LastRow(Sh As Worksheet) As Variant
  On Error Resume Next
  LastRow = Sh.Cells.Find(What:="*", _
                          After:=Sh.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
  On Error GoTo 0
End Function

the second should go into the Search tab code page:
VBA Code: 
Option Explicit

Private Sub ListBox1_Click()
  Dim x
  CompaniesRS.Find "Key='" & ListBox1.Text & "'", , adSearchForward, adBookmarkFirst
  LinkToSheet = CompaniesRS.Fields("WSADDR")
  x = Split(LinkToSheet, "!")
  Application.Goto reference:=Sheets(x(0)).Range(x(1))
  ' return to search tab with mouse or F5 goto menu
End Sub

Private Sub ListBox2_Click()
  Dim x
  ProductsRS.Find "Key='" & ListBox2.Text & "'", , adSearchForward, adBookmarkFirst
  LinkToSheet = ProductsRS.Fields("WSADDR")
  x = Split(LinkToSheet, "!")
  Application.Goto reference:=Sheets(x(0)).Range(x(1))
  ' return to search tab with mouse or F5 goto menu
End Sub

Private Sub TextBox1_Change()
  If Len(TextBox1.Text) > 0 Then
    If TextBox1.Text = "*" Then
      CompaniesRS.Filter = 0
    Else
      CompaniesRS.Filter = "Key LIKE '" & TextBox1.Text & "*'"
    End If
    ListBox1.Clear
    With CompaniesRS
      If .RecordCount > 0 Then
        .MoveFirst
        Do Until .EOF
          ListBox1.AddItem .Fields("Key")
          .MoveNext
        Loop
      End If
    End With
  Else
    ListBox1.Clear
    CompaniesRS.Filter = 0
  End If
End Sub

Private Sub TextBox1_GotFocus()
  ListBox1.Clear
  If CompaniesRS Is Nothing Then
    MakeRecordsets
  End If
  With CompaniesRS
    .Filter = 0
    If .RecordCount > 0 Then
      .MoveFirst
      Do Until .EOF
        ListBox1.AddItem .Fields("Key")
        .MoveNext
      Loop
    End If
  End With
End Sub

Private Sub TextBox1_LostFocus()
  ListBox1.Clear
  TextBox1.Text = ""
End Sub

Private Sub TextBox2_Change()
  If Len(TextBox2.Text) > 0 Then
    If TextBox2.Text = "*" Then
      ProductsRS.Filter = 0
    Else
      ProductsRS.Filter = "Key LIKE '" & TextBox2.Text & "*'"
    End If
    ListBox2.Clear
    With ProductsRS
      If .RecordCount > 0 Then
        .MoveFirst
        Do Until .EOF
          ListBox2.AddItem .Fields("Key")
          .MoveNext
        Loop
      End If
    End With
  Else
    ListBox2.Clear
    ProductsRS.Filter = 0
  End If
End Sub

Private Sub TextBox2_GotFocus()
  ListBox2.Clear
  If ProductsRS Is Nothing Then
    MakeRecordsets
  End If
  With ProductsRS
    .Filter = 0
    If .RecordCount > 0 Then
      .MoveFirst
      Do Until .EOF
        ListBox2.AddItem .Fields("Key")
        .MoveNext
      Loop
    End If
  End With
End Sub

Private Sub TextBox2_LostFocus()
  ListBox2.Clear
  TextBox2.Text = ""
End Sub

Private Sub Worksheet_Activate()
  ListBox1.Clear
  ListBox2.Clear
  TextBox1.Text = ""
  TextBox2.Text = ""
  MakeRecordsets
End Sub

I don't have time right now to describe all this but am willing to talk you through it so you can understand what it is doing and why I designed it this way. Just pr

Something I need to mention. You will need to configure a reference to Microsoft ActiveX Data Objects Recordset Library. Open the VBE, click Tools/References then search for it (may be more than one I used v2.8) and click the checkbox in front of it. Then click OK. Again, as above, don't hesitate to ask questions.
Click to expand...
Hello vw412. I finally finished the data entry onto the worksheet. During the next couple of days I'll see what I can do with your macros. Does both have to be inserted onto the spreadsheet?
 
Upvote 0
Yes they both are required. I will review what I did and be ready for more questions.
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Question Question
Using a set date to prevent access to Excell tabs and macros
Replies
1
Views
233
Micron
M
R
  • Question Question
Excel Database and Dependant Lists
Replies
7
Views
274
felixstraube
F
G
  • Solved
Return location of specific text in workbook
2
Replies
10
Views
230
mumps
mumps
D
  • Solved
VBA xLookup on multiple columns
Replies
6
Views
2K
darkybot
D
S
  • Solved
Search Function Macro not working
Replies
3
Views
74
MARK858
MARK858

Forum statistics

Threads
1,224,828
Messages
6,181,215
Members
453,024
Latest member
Wingit77

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