Ok here is a code to get you started. This looks at the data on the first worksheet in column A. It will put a result into column B. The strings for it to search get entered on the 2nd worksheet. ex: col A = donalds, col B= food.
The code assumes that you have headers for both worksheets and will start on row 2. You can add as many search strings that you want on the 2nd worksheet.
Code:
Option Explicit
Sub IdentifyCharge()
'Looks through column A and an array then identifies the type of charge.
Dim CheckRow As Long, LastRow As Long, CheckString As String
Dim ArrayString As String, TypeArray As Variant, x As Integer
Dim ResultString As String, ResultArray As Variant, ResultValue As String
Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
'Set the references
Set wb = ThisWorkbook
Set ws1 = wb.Worksheets(1)
Set ws2 = wb.Worksheets(2)
LastRow = ws1.Range("A50000").End(xlUp).Row
'Fill in the string with arrays to check
For CheckRow = 2 To 50000
If ws2.Range("A" & CheckRow).Value = "" Then Exit For
ArrayString = ArrayString & ws2.Range("A" & CheckRow).Value & "|"
ResultString = ResultString & ws2.Range("B" & CheckRow).Value & "|"
Next CheckRow
'Remove trailing delimiters
ArrayString = Mid(ArrayString, 1, Len(ArrayString) - 1)
ResultString = Mid(ResultString, 1, Len(ResultString) - 1)
'Convert strings to arrays
TypeArray = Split(ArrayString, "|")
ResultArray = Split(ResultString, "|")
'Run through the list in worksheet 1 and give the results
For CheckRow = 2 To LastRow
ResultString = ""
CheckString = LCase(ws1.Range("A" & CheckRow).Value)
For x = 0 To UBound(TypeArray)
If InStr(1, CheckString, LCase(TypeArray(x))) Then
ResultString = ResultArray(x)
Exit For
End If
Next x
ResultValue = Mid(CheckString, InStr(1, CheckString, "-"))
ResultString = ResultValue & " " & ResultString
ws1.Range("B" & CheckRow).Value = ResultString
Next CheckRow
End Sub
As with all code be sure to save your workbook before running since macro procedures cannot be "undone" once ran.
Let me know how it all works out for you.
Thanks