Is there a better way to compare against many strings with like? - excel

Question

I have a long list of words I need to compare against.
As an example fruit and vegetables that needs to be stored cold vs warmer:
Cold
strawberries
raspberries
lettuce
Warm(er)
cucumber
bell pepper
tomatoes
I have a sheet with products and need to loop it:
For Each cel In rng
If LCase(cel.Value) Like "*strawberries*" Or LCase(cel.Value) Like "*raspberries*" Or LCase(cel.Value) Like "*lettuce*" Then
msgbox "Cold"
ElseIf LCase(cel.Value) Like "*cucumber*" or LCase(cel.Value) Like "*bell pepper*" or LCase(cel.Value) Like "*tomato*" Then
msgbox "Warmer"
End If
Next cel
Is there any way I could this better? The syntax to test against all products will be very very long.
Could I somehow group/list them and make the syntax easier to maintain?
Example of the workbook:

Answer 1

To demonstrate what I meant with a wildcard match:
Sub Test()
Dim rng As Range, cl As Range
Dim Cold As Variant, Warm As Variant
Set rng = ThisWorkbook.Worksheets("Sheet1").Range("A1:A4")
Cold = Array("*strawberries*", "*raspberries*", "*lettuce*")
Warm = Array("*cucumber*", "*bell pepper*", "*tomatoes*")
With Application
For Each cl In rng
If .IsNumber(.Match(True, .IsNumber(.Match(Cold, cl, 0)), 0)) Then
'Or: If UBound(Filter(.IsNumber(.Match(Warm, cl, 0)), True)) = 0 Then
MsgBox "Cold"
ElseIf .IsNumber(.Match(True, .IsNumber(.Match(Warm, cl, 0)), 0)) Then
MsgBox "Warm"
End If
Next
End With
End Sub
Alternatively, you could use regular expressions with word-boundaries:
Sub Test()
Dim rng As Range, cl As Range
Dim Cold As String, Warm As String
Set rng = ThisWorkbook.Worksheets("Sheet1").Range("A1:A4")
Cold = "strawberries|raspberries|lettuce"
Warm = "cucumber|bell pepper|tomatoes"
With CreateObject("vbscript.regexp")
.IgnoreCase = True
For Each cl In rng
.Pattern = "\b" & Cold & "\b"
If .Test(cl) Then
MsgBox "Cold"
Else
.Pattern = "\b" & Warm & "\b"
If .Test(cl) Then MsgBox "Warm"
End If
Next
End With
End Sub
You can also, match both in any case and see if it's supposed to be a combination of warm and cold.

Answer 2

Here is a perfunctory system that would return the information you want from a list of produce.
Sub GetStorageInstruction()
' 187
Dim Veggie As Variant
Dim Storage As String
Dim Txt As String
Veggie = InputBox("Enter name of fruit or vegetable to store:", _
"Get storage instruction")
Veggie = Trim(Veggie)
If Len(Veggie) Then
Storage = StorageInstruction(Veggie)
If Len(Storage) Then
Txt = "Store " & Veggie & " at a " & Storage & " location."
Else
Txt = "Sorry, I couldn't find instructions on" & vbCr & _
"storage of """ & Veggie & """."
End If
MsgBox Txt, vbInformation, "Storage instructions"
End If
End Sub
Private Function StorageInstruction(ByVal Veggie As String) As String
' 187
' return vbNullString if not found
Dim ListRng As Range
Dim Fnd As Range ' found match
Dim C As Long ' column
' here items for "Cold" storage are in column A,
' items for "Cool" storage are in column B
Set ListRng = Range("A:B") ' adjust to suit
Set Fnd = ListRng.Find(Veggie, LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=False)
If Not Fnd Is Nothing Then
' the return result is taken from the caption row (row 1)
' of the column in which a match was found
StorageInstruction = Cells(1, Fnd.Column).Value
End If
End Function
"Ordinarily", you wouldn't work with an InputBox because it's too error prone (typos) but with a validation list or combo box that is based on the same lists. But for the moment, if you are concerned about not finding "Bell peppers" (plural), consider either listing "Bell pepper" as well or modify the search to LookAt:=xlPart.
To make the above code work for you immediately, just type "Cold" in A1, "Cool" in B1 and a list of produce under each header. The code will return the header from the column where the item was found.
I see that you have now added a view of your worksheet. That is a much better base. Instead of the produce name, list a number from your columns C or D (whichever is unique), in my columns A and B, and enter that number in the InputBox. Once you implement that system you can modify the returned answer by using the number to VLOOKUP the product name so that the description appears in the answer along with the number you entered.
As an afterthought, the best way for you would probably be to just select the row you are interested in, click a button (or keyboard shortcut) and have the storage instruction pop up. But the presumption here is that you should be able to attach VBA code to your workbook.

Answer 3

No. Correct. I solved that with search for asparagus then search again in the same string for potatoes. But I know there will be false matches. There is no way around it. Let's just say, if there is a handful of false matches is better than looking through the full sheet manually (30-40 000 rows). – Andreas 1 hour ago
Here is an example of what I recommend. Feel free to go with other answers. If there are multiple matches then fill the cell with "Cold/Warm" as mentioend in the code comments below. This way you can simply filter on these and fix them manually.
Basic Preparation to test this
Create a master sheet in the file which has the code. Let's call it MasterList. The reason why we are doing this is so that it is easier to maintain and when you are distributing the code file, the masterlist is easily available. You can do version control on the file so that everyone uses the current version. Let's say the MasterList looks like this.
Let's say the file (as shown in your image) is called MyData.xlsx and the data is in Sheet1. Feel free to change it in the code below. It looks like this
Code
Option Explicit
Sub Sample()
Dim wsThis As Worksheet
'~~> This is the hidden sheet which has your master list in the file
'~~> which has the code
Set wsThis = ThisWorkbook.Sheets("MasterList")
Dim lRow As Long
Dim MasterList As Variant
With wsThis
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
MasterList = .Range("A2:B" & lRow).Value2
End With
Dim wb As Workbook
Dim wsThat As Worksheet
'~~> Change this to the workbook where the data needs to be checked
Set wb = Workbooks.Open("C:\Users\Siddharth Rout\Desktop\MyData.xlsx")
'~~> Change this to the workseet where the data needs to be checked
Set wsThat = wb.Sheets("Sheet1")
Dim rngToProcess As Range
With wsThat
'~~> Find last row in Col E which has names
lRow = .Range("E" & .Rows.Count).End(xlUp).Row
'~~> Identify your range
Set rngToProcess = .Range("E2:E" & lRow)
'~~> Insert a blank column for output
.Columns(6).Insert Shift:=xlToRight
End With
Dim SearchText As String
Dim aCell As Range, bCell As Range
Dim i As Long
'~~> Loop through the masterlist
For i = LBound(MasterList) To UBound(MasterList)
SearchText = MasterList(i, 1)
Set aCell = rngToProcess.Find(What:=SearchText, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
Set bCell = aCell
'~~> Get the Warm - Cold - Warm/Cold Status
aCell.Offset(, 1).Value = GetStatus(MasterList(i, 2), aCell.Offset(, 1).Value)
'~~> Search again for multiple occurences
Do
Set aCell = rngToProcess.FindNext(After:=aCell)
If Not aCell Is Nothing Then
If aCell.Address = bCell.Address Then Exit Do
aCell.Offset(, 1).Value = GetStatus(MasterList(i, 2), aCell.Offset(, 1).Value)
Else
Exit Do
End If
Loop
End If
Next i
End Sub
'~~> Common function to asign the values
'~~> If there are multiple matches then fill the cell with "Warm/Cold".
'~~> This way you can simply filter on these and fix them manually.
Private Function GetStatus(MasterStatus As Variant, CurrentStatus As String) As String
Dim newStatus As String
If MasterStatus = "Cold" Then
Select Case CurrentStatus
Case "Warm": newStatus = "Warm/Cold"
Case Else: newStatus = MasterStatus
End Select
ElseIf MasterStatus = "Warm" Then
Select Case CurrentStatus
Case "Cold": newStatus = "Warm/Cold"
Case Else: newStatus = MasterStatus
End Select
End If
GetStatus = newStatus
End Function
Output
When you run the above code you get the below output

Answer 4

Here is an alternative to my earlier answer. Install the code below in a standard code module and make some arrangement to call it, perhaps with a keyboard shortcut or even a button on the sheet. Then simply select an item (anywhere in the list, no particular column) and run the code. You don't need to enter anything.
Sub Storage_Instruction()
' 187
Const SKUClm As String = "D" ' change to point at the SKU column in 'Data'
Const DescClm As String = "E" ' change to point at the Description column in 'Data'
Const StgClm As String = "C" ' change to point at Storage Instruction column in WsList
Dim WsData As Worksheet
Dim WsList As Worksheet
Dim SKU As String ' SKU number from row R
Dim Desc As String ' Description from row R
Dim R As Long ' the selected row
Dim LookUpRng As Range ' in WsList
Dim Fnd As Range ' found match
Dim Storage As Variant
Dim Txt As String
Set WsData = Worksheets("Data") ' insert your data sheet's name here
Set WsList = Worksheets("Storage") ' change name to suit
With WsList
' my list has an extra column for 'Description'
' the storage instruction is in column C (=StgClm)
Set LookUpRng = .Range(.Cells(2, "A"), .Cells(.Rows.Count, StgClm).End(xlUp))
End With
If ActiveSheet Is WsData Then
R = Selection.Row
With WsData
SKU = .Cells(R, SKUClm).Value
Desc = .Cells(R, DescClm).Value
End With
Set Fnd = LookUpRng.Find(SKU, LookIn:=xlValues, Lookat:=xlWhole)
If Fnd Is Nothing Then
Txt = "Sorry, I couldn't find instructions for the" & vbCr & _
"storage of " & Desc & "(SKU " & SKU & ")."
Else
Storage = WsList.Cells(Fnd.Row, StgClm).Value
Txt = "Store " & Desc & " (SKU " & SKU & ") at " & String(2, vbCr) & _
String(8, Chr(32)) & UCase(Storage) & String(2, vbCr) & "temperature."
End If
End If
MsgBox Txt, vbInformation, "Storage instruction"
End Sub
For the setup you do need to specify the 3 constants at the top of the procedure and the names of the two worksheets that are referenced.
The list is a simple copy of the SKU column from your big list. In my test I also copied the the descriptions. You may find that way easier to fill the 3rd column, which holds the words "Cool" and "Cold" (or whatever else you want) against each item. The middle column isn't used and not required y the above code.
According to your description, the 'List' sheet should be Very Hidden. In the VB Editor's Project Browser, click on the sheet, bring up its properties and set the Visible property to xlVeryHidden. The sheet can be made visible only by changing this property back to xlVisible. The property setting is saved when you save the workbook.