VBA user form, show the data from one or two words (doesn't matter the position) after the user type

reko

New Member
Joined
Feb 5, 2008
Messages
29
Hello, I'm sorry if my Title question is not clear as I don't know how to properly put it in English.
Here is what I mean :

Suppose that I have a range named ITEM which content :
Fish Snapper Red
Fish Baramundi
Fish Snapper Fillet
Fish Snapper White Fillet
Fish Snapper Red Fillet
Fish Salmon Fillet
Chicken Neck
Chicken Fillet
Pork Loin Rack
Pork Minced
Pork Neck Boneless
Pork Oxtail
Lamb Minced Local
Lamb Neck Boneless

What I want is....

if the user type "fillet" - then all the data contains "fillet" will show :
Fish Snapper Fillet
Fish Salmon Fillet
Chicken Fillet
Fish Snapper White Fillet

if the user type "fish" - then all the data contains "fish" will show.

if the user type "snapper red" OR "red snapper" - then the list show :
Fish Snapper Red
Fish Snapper Red Fillet

if the user type "neck boneless" OR "boneless neck" then all the list show :
Pork Neck Boneless
Lamb Neck Boneless

and so on.

Below is a code for the User Form which I found from the internet.
To be honest, I don't know/understand the code but it works well if the user type one word or two words that match in the data.

Code:
Private Sub FoundNameBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Dim ws As Worksheet
If KeyAscii = 13 Then
Set ws = Worksheets("DAILY")
ws.Range("h2").Value = Me.FoundNameBox.Value
ws.Range("e16").Select
Unload Me
End If
ActiveSheet.Protect
End Sub


Private Sub FoundNameBox_Click()
Dim ws As Worksheet
Set ws = Worksheets("DAILY")
ws.Range("h2").Value = Me.FoundNameBox.Value
ws.Range("e16").Select
End Sub


Private Sub OK_button_Enter()
Unload Me
End Sub

Private Sub UserForm_Activate()
Dim arTemp() As String 'Temp Array
Dim bFound As Boolean 'Flag
Dim i1 As Integer 'Array Counter
Dim cari As String
Dim lingkup As String

lingkup = "ITEM" 'range name of the items

Sheets("TABLE").Activate
cari = InputBox("Type a word you want to find")
bFound = FindAll(cari, ActiveSheet, lingkup, arTemp())

If bFound = True Then
  For i1 = 1 To UBound(arTemp)
  result = Range(arTemp(i1)).Value
  FoundNameBox.AddItem result
  Next i1
  Else
  MsgBox "The word that you are looking for has no match"
End If

Sheets("DAILY").Activate
If Me.FoundNameBox.ListCount = 0 Then
  Unload Me
  Else
  FoundNameBox.ListIndex = 0
End If
End Sub


Function FindAll(ByVal sText As String, ByRef oSht As Worksheet, ByRef sRange As String, ByRef arMatches() As String) As Boolean

' --------------------------------------------------------------------------------------------------------------
' FindAll - To find all instances of the given string and return the row numbers.
' If there are not any matches the function will return false
' --------------------------------------------------------------------------------------------------------------

On Error GoTo Err_Trap

Dim rFnd As Range ' Range Object
Dim iArr As Integer ' Counter for Array
Dim rFirstAddress ' Address of the First Find

' -----------------
' Clear the Array
' -----------------

Erase arMatches
Set rFnd = oSht.Range(sRange).Find(What:=sText, LookIn:=xlValues, LookAt:=xlPart)

If Not rFnd Is Nothing Then
  rFirstAddress = rFnd.Address
  Do Until rFnd Is Nothing
  iArr = iArr + 1
  ReDim Preserve arMatches(iArr)
  arMatches(iArr) = rFnd.Address ' rFnd.Row ' Store the Row where the text is found
  Set rFnd = oSht.Range(sRange).FindNext(rFnd)
     If rFnd.Address = rFirstAddress Then Exit Do ' Do not allow wrapped search
     Loop
     FindAll = True
     Else
' ----------------------
' No Value is Found
' ----------------------
     FindAll = False
End If

' -----------------------
' Error Handling
' -----------------------
Err_Trap:
If Err <> 0 Then
'MsgBox Err.Number & " " & Err.Description, vbInformation, "Find All"
Err.Clear
FindAll = False
Exit Function
End If
End Function

From the code above - if I search by typing (for example) "fish" then all the data contains the word "fish" will show.
If I type "snapper red" then all the data contains "snapper red" will show.

But if I search by typing
Code:
red snapper
then it won't find anything.
The thing that I want to achieve is if I type
Code:
red snapper
then it will also show the data which contains those two words. So it doesn't care the order of the words, even if the Item name is (for example) Red Fillet Fish Snapper it will show when I type either
Code:
red snapper
or
Code:
snapper red
.

Something like if a user type in the Google Search box either
Code:
red snapper
or
Code:
snapper red
then the search result contains those two words (doesn't matter where the position is) will show. Only if the user type in the Google Search box with apostrophe
Code:
"snapper red"
then the result which contains
Code:
snapper red
will show.

So, is it doable ?
If it's doable, how is the code ?
(If it's not doable, please forget my question)

Any kind of respond would be greatly appreciated.
Thank you in advanced.
 
Last edited:

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Because I cannot edit my post before, for the time being I try a stupid way like this :

Code:
Sub Macro1()

Dim ws As Worksheet
Set ws = Worksheets("Sheet2")

ws.Range("AA1:AD1").ClearContents 'temporary column helper
ws.Range("AE:AE").ClearContents 'temporary column helper

Set Lokasi = ws.Range("AA1") 'temporary column helper for input.value
cari = InputBox("Type the word/words you are looking for (not more than three words)")
Lokasi.Value = cari

'use text-to-column function where the result is put in the temporary column AB1
    Lokasi.TextToColumns Destination:=Range("AB1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
        TrailingMinusNumbers:=True

'count how many column which has a text
n = Application.WorksheetFunction.CountA(ws.Range("AB1:AD1"))

v1 = ws.Range("AB1").Value
v2 = ws.Range("AC1").Value
v3 = ws.Range("AD1").Value

'if only the first column which has a text
If n = 1 Then
    For Each r In ActiveSheet.Range("item")
        v = r.Value
        If InStr(LCase(v), LCase(v1)) > 0 Then
           ws.Range("AE60000").End(xlUp).Offset(1, 0).Value = v
        End If
    Next r
End If


'if there are two columns which has a text
If n = 2 Then
    For Each r In ActiveSheet.Range("item")
        v = r.Value
        If InStr(LCase(v), LCase(v1)) > 0 And InStr(LCase(v), LCase(v2)) > 0 Then
           ws.Range("AE60000").End(xlUp).Offset(1, 0).Value = v
        End If
    Next r
End If

'if there are three columns which has a text
If n = 3 Then
    For Each r In ActiveSheet.Range("item")
        v = r.Value
        If InStr(LCase(v), LCase(v1)) > 0 And InStr(LCase(v), LCase(v2)) > 0 And InStr(LCase(v), LCase(v3)) > 0 Then
           ws.Range("AE60000").End(xlUp).Offset(1, 0).Value = v
        End If
    Next r
End If

'count how many row is the result then name the range
rCount = Application.WorksheetFunction.CountA(Range("AE:AE"))
If rCount = 1 Then
ws.Range("AE2").Name = "result"
Else
ws.Range("AE2", ws.Range("AE60000").End(xlUp)).Name = "result"
End If

frmListItem.Show
End Sub


Private Sub UserForm_Initialize()
Dim ws As Worksheet
Set ws = Worksheets("Sheet2")
Set Rng = ws.Range("result")
For Each cell In Rng.Cells
        ListItem.AddItem cell.Value
    Next cell
End Sub
It works as expected. But there are too many IFs.
Maybe somebody can help me with a simpler way ?

Thank you.
 
Upvote 0

Forum statistics

Threads
1,224,827
Messages
6,181,200
Members
453,022
Latest member
RobertV1609

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