Search worksheet for with a changeable column search

[ipbr21054]

I currently use the following code.

I have a userform which has a TextBox where a value to be searched for is entered.
A command button is then pressed to search for that value.
Found values are then placed into the Listbox by their Row number.

Currently the code searches the whole worksheet & i end up with many values in the Listbox.
Because of the entered Row numbers im having to look at each one so im looking to make it a bit easier.

Now either the code is in need of changing OR maybe if possible be edited so a Textbox can be added to the existing userform where the user would enter a value to be searched & also enter the column to searched.

Example.
Currently the user would type FRANCIS
The code searches all the worksheet & the values are shown like so in the Listbox.
1
22
29
36
100
345
457

If the user could also type the column to be searched say column F then run the code to search.
The Listbox would look like,
100
457

Private Sub ClearSearchField_Click()
    TextBox1.Value = ""
    ListBox1.Clear
    TextBox1.SetFocus
    Range("A6").Select
End Sub

Private Sub CloseForm_Click()
    Unload DatabaseSearch
End Sub

Private Sub FindTheValue_Click()
    Application.ScreenUpdating = False
    Dim fnd As Range, srcRng As Range, i As Long, sAddr As String, srcWS As Worksheet, dic As Object
    Set srcWS = Sheets("DATABASE")
    Set srcRng = srcWS.Range("B6", srcWS.Range("AC" & Rows.count).End(xlUp))
    Set dic = CreateObject("scripting.dictionary")
    If TextBox1.Value = "" Then
        MsgBox "PLEASE TYPE A VALUE TO SEARCH FOR", vbCritical + vbOKOnly, "SEARCH BOX IS EMPTY"
    Else
        Set fnd = srcRng.Find(Me.TextBox1.Value, LookIn:=xlValues, LookAt:=xlPart)
        If Not fnd Is Nothing Then
            sAddr = fnd.Address
            Do
                If Not dic.Exists(fnd.Row) Then
                    dic.Add fnd.Row, Nothing
                    ListBox1.AddItem fnd.Row
                End If
                Set fnd = srcRng.FindNext(fnd)
            Loop While fnd.Address <> sAddr
            sAddr = ""
        Else
            MsgBox "NOTHING TO MATCH THE SEARCH VALUE", vbCritical, "VALUE NOT FOUND MESSAGE"
            TextBox1.Value = ""
            TextBox1.SetFocus
        
        End If
    End If
    Application.ScreenUpdating = True

End Sub

Private Sub ListBox1_Click()
Range("A" & ListBox1.List(ListBox1.ListIndex, 0)).Select
End Sub

 

[saboh12617]

Hello,

From what i understand, you can add a TextBox which contains the column to look at, and then replace the address indicated in

Set srcRng = srcWS.Range("B6", srcWS.Range("AC" & Rows.count).End(xlUp))

By, let's say the column is entered in the TextBox "TBCol" :

If TBCol.Value <> "" Then ' if the TextBox is not empty
    Set srcRng = srcWS.Range(TBCol.Value & ":" TBCol.Value)
Else ' if the TextBox is empty, we use your previous range
    Set srcRng = srcWS.Range("B6", srcWS.Range("AC" & Rows.count).End(xlUp))
End If

Be careful it will raise an error if the given value is not a valid column name.

 

[mumps]

See if this does what you want:

Private Sub FindTheValue_Click()
    Application.ScreenUpdating = False
    Dim fnd As Range, srcRng As Range, i As Long, sAddr As String, srcWS As Worksheet, dic As Object, col As String
    Set srcWS = Sheets("DATABASE")
    Set dic = CreateObject("scripting.dictionary")
    If TextBox1.Value = "" Then
        MsgBox "PLEASE TYPE A VALUE TO SEARCH FOR.", vbCritical + vbOKOnly, "SEARCH BOX IS EMPTY"
        Exit Sub
    Else
        col = InputBox("ENTER THE LETTER OF THE COLUMN TO SEARCH.")
        If col = "" Then
            MsgBox ("NO COLUMN LETTER WAS ENTERED. PLEASE TRY AGAIN AND ENTER THE LETTER OF THE COLUMN TO SEARCH.")
            Unload Me
            Exit Sub
        End If
        Set srcRng = srcWS.Range(col & "6", srcWS.Range(col & Rows.Count).End(xlUp))
        Set fnd = srcRng.Find(Me.TextBox1.Value, LookIn:=xlValues, LookAt:=xlPart)
        If Not fnd Is Nothing Then
            sAddr = fnd.Address
            Do
                If Not dic.Exists(fnd.Row) Then
                    dic.Add fnd.Row, Nothing
                    ListBox1.AddItem fnd.Row
                End If
                Set fnd = srcRng.FindNext(fnd)
            Loop While fnd.Address <> sAddr
            sAddr = ""
        Else
            MsgBox "NOTHING TO MATCH THE SEARCH VALUE.  PLEASE ENTER A VALID SEARCH VALUE OR A VALID COLUMN LETTER.", vbCritical, "VALUE NOT FOUND MESSAGE"
            TextBox1.Value = ""
            TextBox1.SetFocus
        
        End If
    End If
    Application.ScreenUpdating = True
End Sub

 

[ipbr21054]

Many thanks,
I used mumps code & works well

 

[mumps]

You are very welcome.