VBA tag rows if a cell consists of at least one of some provided strings

Question

I try to get my finances together and for that downloaded my data from the local bank as excel. As it is pretty wild (and some years), I want display the data summed up for what I use my money for, as "food", "rent" and stuff. For that I want to go through all the rows and check if a certain cell in the row contains any known word, where I know where to put it in my expenses.

For example: if there is the name of a restaurant in a certain cell, it is a food expense, but the same if it is walmart for example.

I came up with something like:

    Dim food() As String
    food(0) = "Nespresso"
    food(1) = "Spar"
    food(2) = "Billa"

    Dim SrchRng As Range, cel As Range
    
    Set SrchRng = Range("I3:I9")
    
    For Each cel In SrchRng
        If InStr(1, cel.Value, food(0)) Or InStr(1, cel.Value, food(1)) Or InStr(1, cel.Value, food(2)) > 0 Then
            cel.Offset(0, 3).Value = "Essen/Trinken"
        Else
            cel.Offset(0, 3).Value = "-"
        End If
    Next cel

But there are some problems with the code:

1. if all the variables are in a array, there certanly is a way to not be specific and go through array(0), (1), ... but I don't know how.
2. to make it more "editable" and convenient, I don't want to hardcode it, but have a 2nd sheet which displays "food" in A1 and on A2-n the different variables for food(0)-food(n-2) should be used.
3. using the range to a fixed amount also is not a good way how to make sure to work on any given data, it would be best to check for the last row with data first

I already found ways to come to answer point 3 tho.

Everything would help. Thanks in advice :)

Answer 1

I'm not so sure if I understand you correctly. Anyway....

to make it more "editable" and convenient, I don't want to hardcode it, but have a 2nd sheet which displays "food" in A1 and on A2-n the different variables for food(0)-food(n-2) should be used.

As seen in the image above, in Sheet2 there is a table for lookup of the expenses - and in Sheet1 column i is the expenses.

The expected result after running the macro is something like below :

Sub test()
Dim rgData As Range: Dim rgExp As Range: Dim rgU As Range
Dim c As Range: Dim cell As Range: Dim fa As String

With Sheets("Sheet1")
Set rgData = .Range("i3:i14") 'change if needed
End With

With Sheets("Sheet2")
Set rgExp = .Range("A1", .Range("A1").End(xlDown)) 'change if needed
End With

For Each cell In rgExp
    Set c = rgData.Find(cell.Value, lookat:=xlPart)
    If Not c Is Nothing Then
        fa = c.Address
            Do
                If rgU Is Nothing Then Set rgU = c Else Set rgU = Union(rgU, c)
                Set c = rgData.FindNext(c)
            Loop Until c.Address = fa
        rgU.Offset(0, 3).Value = cell.Offset(0, 1).Value
        Set rgU = Nothing
    End If
Next

End Sub

rgExp is the range of column A in Sheet2.
rgData is the range of column i in Sheet1.

The loop is not within the rgData but rgExp.
Within this loop, it loop with find/find-next method to unite the range of the found cell (which value contains the looped cell value in rgExp) as rgU variable. Then it fill the rgU.offset(0,3) with the looped cell.offset(0,1) value.

If in Sheet2 the table you want is something like this :

Then set the rgExp like this

With Sheets("Sheet2")
 Set rgExp = .UsedRange.Offset(1, 0).SpecialCells(xlConstants)
End With

and after the find-next loop done, the filling for the rgU.offset(0,3) is like this :

rgU.Offset(0, 3).Value = rgExp.Find(cell.Value).End(xlUp).Value

Answer 2

This is the perfect time to use a function. You can create a function which loops through multiple search terms, checking each of them and returning the result.

Function FindAny(SearchIn As String, LookFor() As String, Optional Start As Long = 1, Optional Compare As VbCompareMethod = vbTextCompare) As Boolean
    'Search for each of the given search terms in the given string, return true if any of them are found.
    Dim SearchTerm As Variant
    For Each SearchTerm In LookFor
        If InStr(Start, SearchIn, SearchTerm, Compare) <> 0 Then
            FindAny = True
            Exit Function
        End If
    Next
    'Else - Search terms not found
    FindAny = False
End Function

Here's how to include that in your original code:

Sub Example()
    Dim Food() As String
    Food = Split("Nespresso,Spar,Billa", ",")
    
    Dim SrchRng As Range, cel As Range
    
    Set SrchRng = Range("I3:I9")
    
    For Each cel In SrchRng
        If FindAny(CStr(cel.Value), Food) Then
            cel.Offset(0, 3).Value = "Essen/Trinken"
        Else
            cel.Offset(0, 3).Value = "-"
        End If
    Next cel
End Sub