How to cycle through the results of a VLOOKUP

[DanMee]

Hi,

I have a userform that people can use to search a datalist to return a possible match. The form has a combobox (SearchType, with options Item Code or Description), a textbox (SearchString), a command button (BeginSearch), and 2 textboxes (CodeReturn and DescriptionReturn)

At present the command button has the following code:

Private Sub BeginSearch_Click()

Range("VLOOKUPType").Value = SearchType
Range("ItemCodeSearch").Value = SearchString
Range("ItemCodeSearch").Select
With Selection
        Selection.NumberFormat = "General"
        .Value = .Value
End With
CodeReturn.Value = Range("CodeReturn")
DescriptionReturn.Value = Range("DescReturn")




End Sub

The ranges are on a sheet within the workbook. VLOOKUPTYPE and ItemCodeSearch are just for input form the macro - CodeReturn and DescReturn both have formula in as such:

=IFERROR(IF(VLOOKUPType="","",IF(VLOOKUPType="Item Code",VLOOKUP("*"&ItemCodeSearch&"*",Datalist,1,FALSE),IF(VLOOKUPType="Description",VLOOKUP("*"&ItemCodeSearch&"*",ExtDataList,1,FALSE),""))),"Not Found")

The only difference between CodeReturn and DescReturn is the column numbers in the formula.

Right now the background is done, my problem.

I want to be able to cycle through possible matches on the userform. At the moment the formula + macro returns the top match, however for example:

If Paper is typed as a description search then it will return A4 Blue Paper x500, but then A4 Paper x500 might be what the user wants to get the code for.

Is there a way of building a macro into the userform (on new Buttons named NextSearch and BackSearch for example) that owuld move back and forwards through relevance?

Using Excel 2007

Long questions sorry! Many thanks for any replies!

 

[DanMee]

Shameless Bump!

 

[Jerry Sullivan]

Hi DanMee,

Instead of using a worksheet formula to do the search; consider finding matches directly with VBA using the Range.Find method.

For the initial search, you could use Range.Find to find the first cell (if any) within the search range that has a match.
Use the parameter LookAt:=xlPart to find partial matches as you are doing in your Vlookup.

The Next and Previous buttons could then use Range.Find again with the parameters:
After:= cell from your previous match
SearchDirection:=xlNext or xlPrevious depending on the button

Just ask if you want some help with the coding.

 

[DanMee]

Hi JS411,

Thanks for the response! I've not come across that function before - I'll have a go at reading around it and implementing it. I'll certainly post if I get stuck!

Many thanks!

Dan

 

[DanMee]

Hi,

As mentioned I'll have a go at this bit of code, and I have - however I've come unstuck on the next/previous parts.

Below is the code for the initial search:

Private Sub GoSearch_Click()


Application.ScreenUpdating = False


If SearchType.ListIndex = -1 Then
    MsgBox "Please Select a Search Type", vbOKOnly, "No Search Type Selected"
    Exit Sub
End If


If SearchString = "" Then
    MsgBox "Please Enter a Search", vbOKOnly, "No Search Entered"
    Exit Sub
End If


If SearchType = "Code" Then
 Dim search As String
    Dim FoundRange As Range
     
    search = SearchString.Value
    Worksheets("Data").Activate
     
    Set FoundRange = Sheets("Data").Range("CodesSet").Find(what:=search, LookIn:=xlFormulas, lookat:=xlPart)
     
    If FoundRange Is Nothing Then
        CodeFound.Text = "Not Found"
        DescFound.Text = "Not Found"
    Else
        CodeFound.Text = FoundRange.Value
        DescFound.Text = FoundRange.Offset(0, 1).Value
    End If
End If


If SearchType = "Description" Then
     
    search = SearchString.Value
    Worksheets("Data").Activate
     
    Set FoundRange = Sheets("Data").Range("DescSet").Find(what:=search, LookIn:=xlFormulas, lookat:=xlPart)
     
    If FoundRange Is Nothing Then
        CodeFound.Text = "Not Found"
        DescFound.Text = "Not Found"
    Else
        DescFound.Text = FoundRange.Value
        CodeFound.Text = FoundRange.Offset(0, -1).Value
    End If
End If


Application.ScreenUpdating = True


End Sub

And here is the 'next' button code i'm using:

Private Sub NextSearch_Click()

If SearchType = "Code" Then
 Dim search As String
    Dim FoundRange As Range
     
    search = SearchString.Value
    Worksheets("Data").Activate
     
    Set FoundRange = Sheets("Data").Range("A2:A6000").FindNext()
     
    If FoundRange Is Nothing Then
        CodeFound.Text = "Not Found"
        DescFound.Text = "Not Found"
    Else
        CodeFound.Text = FoundRange.Value
        DescFound.Text = FoundRange.Offset(0, 1).Value
    End If
End If


If SearchType = "Description" Then
     
    search = SearchString.Value
    Worksheets("Data").Activate
     
    Set FoundRange = Sheets("Data").Range("B2:B6000").FindNext()
     
    If FoundRange Is Nothing Then
        CodeFound.Text = "Not Found"
        DescFound.Text = "Not Found"
    Else
        DescFound.Text = FoundRange.Value
        CodeFound.Text = FoundRange.Offset(0, -1).Value
    End If
End If


End Sub

The 'previous' is almost identical (except with appropriate 'FindPrevious' instead of 'FindNext')

The next and previous just seem to cycle between 2 results instead of continuing and looping back round. Anyone able to help?

Kind regards,

Dan

 

[Jerry Sullivan]

Dan,

You'll need to use the After:= parameter of the Find.Range Method to tell Excel to start with the previously found cell.

If you have no other Userform events that will modify the ActiveCell after the last Find, then you could just use
After:=ActiveCell

Otherwise, you'll want to store the last found cell's address so it can be retrieved. You could store the address in the Tag Property of one of your UserForm objects, a worksheet cell, a defined name or a public variable.

I'm busy now, but I could help with some code later tonight if you aren't unstuck by then.

 

[Jerry Sullivan]

Dan, Here's some code that you can try.

The approach uses a one Sub that is called by all three buttons.
This will eliminate duplication of code and simplify maintenance.

When a match is found, it's stored in the Tag Property of the GoSearch button.
This serves as the After:= parameter to do Next/Previous searches.

Private Sub DoSearch(Optional iDirection As Integer = xlNext)
    Dim FoundRange As Range, rCode As Range, rAfter As Range
    Dim iOffset As Integer

    
    Select Case SearchType.Value
        Case "Code": iOffset = 0
        Case "Description": iOffset = 1
        Case Else
            MsgBox "Please Select a Search Type", vbOKOnly, "No Search Type Selected"
            Exit Sub
    End Select

    
    If SearchString.Value = "" Then
        MsgBox "Please Enter a Search", vbOKOnly, "No Search Entered"
        Exit Sub
    End If

    With Sheets("Data")
        Set rCode = .Range("A2:A6000")
        If Me.GoSearch.Tag = "" Then
            '--new search. Start from bottom so top cell is next
            Set rAfter = rCode(rCode.Rows.Count).Offset(0, iOffset)
        Else
            '--resuming search. Start from last found address
            Set rAfter = .Range(Me.GoSearch.Tag)
        End If
        Set FoundRange = rCode.Offset(0, iOffset).Find(What:=SearchString.Value, _
             After:=rAfter, LookIn:=xlFormulas, LookAt:=xlPart, SearchDirection:=iDirection)


        If FoundRange Is Nothing Then
            CodeFound.Text = "Not Found"
            DescFound.Text = "Not Found"
            Call ClearLast
        Else
            CodeFound.Text = .Cells(FoundRange.Row, "A")
            DescFound.Text = .Cells(FoundRange.Row, "B")
            Call SaveLast(FoundRange.Address)
        End If
    End With

End Sub

These other event procedures control the process of storing/clearing the last found address.
The Next/Previous buttons are disabled when no last found address is stored.
All the code on this post should be pasted into your UserForm's code module.

Private Sub ClearLast()
'--clear last found address and disable next/previous
    With Me
        .GoSearch.Tag = ""
        .NextSearch.Enabled = False
        .PreviousSearch.Enabled = False
    End With
End Sub

Private Sub SaveLast(rFound As Range)
'--store last found address and enable next/previous
    With Me
        .GoSearch.Tag = rFound.Address
        .NextSearch.Enabled = True
        .PreviousSearch.Enabled = True
    End With
End Sub

Private Sub GoSearch_Click()
    Call ClearLast
    Call DoSearch
End Sub

Private Sub NextSearch_Click()
    Call DoSearch(iDirection:=xlNext)
End Sub

Private Sub PreviousSearch_Click()
    Call DoSearch(iDirection:=xlPrevious)
End Sub

Private Sub SearchString_Change()
    Call ClearLast
End Sub

Private Sub SearchType_Change()
    Call ClearLast
End Sub

 

[Jerry Sullivan]

In the Sub DoSearch, please make this correction:

Replace:

Call SaveLast([COLOR="#FF0000"]FoundRange.Address[/COLOR])

With this:

Call SaveLast([COLOR="#0000CD"]FoundRange[/COLOR])

 

[DanMee]

HI J,

Thanks for pointing me in the right direction! This is now working!

In the interest of sharing, below is my amended code:

Private Sub GoSearch_Click()

Application.ScreenUpdating = False


If SearchType.ListIndex = -1 Then
    MsgBox "Please Select a Search Type", vbOKOnly, "No Search Type Selected"
    Exit Sub
End If


If SearchString = "" Then
    MsgBox "Please Enter a Search", vbOKOnly, "No Search Entered"
    Exit Sub
End If


If SearchType = "Code" Then
 Dim search As String
    Dim FoundRange As Range
     
    search = SearchString.Value
    Worksheets("Data").Activate
     
    Set FoundRange = Sheets("Data").Range("CodesSet").Find(What:=search, LookIn:=xlValues, Lookat:=xlPart)
     
    If FoundRange Is Nothing Then
        CodeFound.Text = "Not Found"
        DescFound.Text = "Not Found"
    Else
        CodeFound.Text = FoundRange.Value
        DescFound.Text = FoundRange.Offset(0, 1).Value
        FoundRange.Select
    End If
End If


If SearchType = "Description" Then
     
    search = SearchString.Value
    Worksheets("Data").Activate
     
    Set FoundRange = Sheets("Data").Range("DescSet").Find(What:=search, LookIn:=xlValues, Lookat:=xlPart)
     
    If FoundRange Is Nothing Then
        CodeFound.Text = "Not Found"
        DescFound.Text = "Not Found"
    Else
        DescFound.Text = FoundRange.Value
        CodeFound.Text = FoundRange.Offset(0, -1).Value
        FoundRange.Select
    End If
End If


Application.ScreenUpdating = True


End Sub

and

Private Sub NextSearch_Click()

If SearchType = "Code" Then
 Dim search As String
    Dim FoundRange As Range
     
    search = SearchString.Value
    Worksheets("Data").Activate
     
    Set FoundRange = Sheets("Data").Range("A2:A6000").Find(What:=search, After:=ActiveCell, Lookat:=xlPart, SearchDirection:=xlNext)
     
    If FoundRange Is Nothing Then
        CodeFound.Text = "Not Found"
        DescFound.Text = "Not Found"
    Else
        CodeFound.Text = FoundRange.Value
        DescFound.Text = FoundRange.Offset(0, 1).Value
        FoundRange.Select
    End If
End If


If SearchType = "Description" Then
     
    search = SearchString.Value
    Worksheets("Data").Activate
     
    Set FoundRange = Sheets("Data").Range("B2:B6000").Find(What:=search, After:=ActiveCell, Lookat:=xlPart, SearchDirection:=xlNext)
     
    If FoundRange Is Nothing Then
        CodeFound.Text = "Not Found"
        DescFound.Text = "Not Found"
    Else
        DescFound.Text = FoundRange.Value
        CodeFound.Text = FoundRange.Offset(0, -1).Value
        FoundRange.Select
    End If
End If


End Sub

Many thanks again!

 

[DanMee]

Ah thanks for the code! board was taking an age to post my reply!

I'll implement yours as mine is rather messy and repeated over 3 subs for the 3 buttons!

Thanks again!