Search User Input String in variants of string - find all in any order contained

Michael813 · Jul 2nd 2013

Hi all,

First post - so hello one and all.

I am stuck with using a user input search term in a cell, and finding variants of this string.

Cell Entry Example: Professional Land Fees

I want to then find all cells that contain all of those words in all orders (eg Professional Land Fees / Land Professional Fees / Fees Land Professional / Land Fees Professional) - I am able to search and then carry out actions when the string is found in the order of user entry, I am struggling with coding it to look for all variants.

Any help very much appreciated.

Thank you in Advance.

Code

For Each Cell In SearchRange
    If InStr(Cell, Findvalue) > 0 Then
    MsgBoxStr = MsgBoxStr & Cell.Offset(0, 3).Value & " - " & Cell.Offset(0, 4).Value & vbCr
    End If
    Next Cell

jindon · Jul 2nd 2013

Re: Search User Input String in variants of string - find all in any order contained

One way

Code

Sub test()
    Dim myPtn As String, r As Range, x As Range, ff As String
    myPtn = "(Professional|Land|Fees)"
    With CreateObject("VBScript.RegExp")
        .Pattern = "^" & myPtn & " (?!\1)" & myPtn & " (?!(\1|\2))" & myPtn & "$"
        Set r = Cells.Find("Professional", , , 2)
        If Not r Is Nothing Then
            ff = r.Address
            Do
                If .test(r.Value) Then
                    If Not x Is Nothing Then
                        Set x = Union(x, r)
                    Else
                        Set x = r
                    End If
                End If
                Set r = Cells.FindNext(r)
            Loop Until ff = r.Address
        End If
        If Not x Is Nothing Then x.Select
    End With
End Sub

Display More

ashu1990 · Jul 2nd 2013

Re: Search User Input String in variants of string - find all in any order contained

try this

Code

Sub test()
For Each cell In ActiveSheet.UsedRange
          MsgBox cell
    If InStr(LCase(cell), "Professional") >= 0 And InStr(LCase(cell), "land") > 0 And InStr(LCase(cell), "fees") > 0 Then
       msgboxstr = msgboxstr & cell.Offset(0, 3).Value & " - " & cell.Offset(0, 4).Value & vbCr
        
    End If
  
Next cell
 
End Sub

Display More

Michael813 · Jul 2nd 2013

Re: Search User Input String in variants of string - find all in any order contained

Hi,

I looked at that previously, however the cell entry of user input is variable. So, it can be 1 word, or 4 words - I am trying to locate all words within a cell (no matter what order). I have tried SPLIT, and building up muti strings with JOIN, but to no avail. I am struggling with the flexibility of multiple words and arrangement.

Thank you both for your help....

jindon · Jul 2nd 2013

Re: Search User Input String in variants of string - find all in any order contained

Code

Sub test()
    Dim r As Range, rng As Range, ff As String, e, AL As Object, x As Object
    Set AL = CreateObject("System.Collections.ArrayList")
    For Each e In Split("Land,Fees,Professional", ",")  '<-----alter to suite here
        AL.Add StrConv(e, vbProperCase)
    Next
    Set r = Cells.Find("Professional", , , 2)
    If Not r Is Nothing Then
        ff = r.Address
        Do
            Set x = AL.Clone
            For Each e In Split(r.Value)
                If Not x.Contains(StrConv(e, vbProperCase)) Then
                    Set x = Nothing: Exit For
                Else
                    x.Remove StrConv(e, vbProperCase)
                End If
            Next
            If Not x Is Nothing Then
                If x.Count = 0 Then
                    If rng Is Nothing Then
                        Set rng = r
                    Else
                        Set rng = Union(rng, r)
                    End If
                End If
            End If
            Set r = Cells.FindNext(r)
        Loop Until ff = r.Address
    End If
    If Not rng Is Nothing Then rng.Select
End Sub

Display More

Michael813 · Jul 2nd 2013

Re: Search User Input String in variants of string - find all in any order contained

Thanks, although this is a little beyond my understanding, and I am having issues in converting your code to my use.

My search range and search string are set and entered into your code as:

Code

Dim Findvalue As String
Dim SearchRange As Range
Set SearchRange = Sheets("Cost_Heads").Range("B8:B200")
Findvalue = Sheets("Mapping_LookUp_Tool").Range("E12").Value
    Set AL = CreateObject("System.Collections.ArrayList")
    For Each e In Split(Findvalue, " ")
        AL.Add StrConv(e, vbProperCase)
    Next

However I am then stuck on the rest in looping through each cell in the searchrange to find all words......

Sorry for being spoon fed....

jindon · Jul 2nd 2013

Re: Search User Input String in variants of string - find all in any order contained

If Mapping_LookUp_Tool!E12 contains one or multiple string separated by single space then this code should work.
Otherwise need to see your workbook.

Code

Sub test()
    Dim SearchRange As Range, r As Range, rng As Range, ff As String
    Dim e, AL As Object, x As Object
    Set AL = CreateObject("System.Collections.ArrayList")
    For Each e In Split(Sheets("Mapping_LookUp_Tool").Range("E12").Value)
        AL.Add StrConv(e, vbProperCase)
    Next
    Set SearchRange = Sheets("Cost_Heads").Range("B8:B200")
    With SearchRange
        .Parent.Select
        Set r = .Cells.Find(Split(Sheets("Mapping_LookUp_Tool").Range("E12").Value)(0), , , 2)
        If Not r Is Nothing Then
            ff = r.Address
            Do
                Set x = AL.Clone
                For Each e In Split(r.Value)
                    If Not x.Contains(StrConv(e, vbProperCase)) Then
                        Set x = Nothing: Exit For
                    Else
                        x.Remove StrConv(e, vbProperCase)
                    End If
                Next
                If Not x Is Nothing Then
                    If x.Count = 0 Then
                        If rng Is Nothing Then
                            Set rng = r
                        Else
                            Set rng = Union(rng, r)
                        End If
                    End If
                End If
                Set r = .Cells.FindNext(r)
            Loop Until ff = r.Address
        End If
    End With
    If Not rng Is Nothing Then rng.Select
End Sub

Display More

Michael813 · Jul 2nd 2013

Re: Search User Input String in variants of string - find all in any order contained

Thanks for the help and responses. I ended up with the following:

Code

Sub SearchCostHead()
Dim Findvalue As String
Dim SearchRange As Range
Dim MsgBoxStr As String
Set SearchRange = Sheets("Cost_Heads").Range("B8:B200")
Findvalue = Sheets("Mapping_LookUp_Tool").Range("E12").Value
Searchset = Split(Findvalue, " ")
WrdNum = UBound(Searchset) + 1
numfound = 0
For Each Cell In SearchRange
 For j = 0 To WrdNum - 1
 If InStr(Cell, Searchset(j)) > 0 Then numfound = numfound + 1
 Next j
 If numfound = WrdNum Then
 MsgBoxStr = MsgBoxStr & Cell.Offset(0, -1).Value & " - " & Cell.Offset(0, 0).Value & vbCr
 Else
 End If
 
 numfound = 0
Next Cell
If Len(MsgBoxStr) > 1 Then
MsgBox "Your Search of '" & Findvalue & "'" & vbCr & vbCr & "Returns suggested project cost code(s)" & vbCr & vbCr & MsgBoxStr & vbCr & vbCr & "Please note: This is only a suggestion tool and there maybe a more suitable codes available." & vbCr & vbCr & "Please refer to the Cost_Heads sheet for a more detailed listing of available codes." & vbCr & vbCr & "Thank You", vbOKOnly, "Result! We have found a suggestion!"
Else
MsgBox "Sorry, your search for '" & Findvalue & "'" & " has not returned any results." & vbCr & vbCr & "Please try again.", vbOKOnly, "Sorry, we have not found a suggestion"
End If
End Sub

Display More

István Hirsch · Jul 5th 2013

Re: Search User Input String in variants of string - find all in any order contained

Hope you can use this as a UDF. Instead of "OK" in the code you can use, for example, the original user input (now: Professional Land Fees)

Function FindPerm(c As String) As String
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "(Professional)|(Land)|(Fees)" 'Insert more words with similar structure
FindPerm = .Replace(c, "#")
.Pattern = "^# # #$" 'Insert more # with space
If .Test(FindPerm) Then
FindPerm = .Replace(FindPerm, "OK")
Else
FindPerm = ""
End If
End With
End Function

Search User Input String in variants of string - find all in any order contained

Participate now!

Share