VBA find method and named range not working

So I am trying to keep track of my budget using excel. Each month I paste various information, including expense descriptions, into a worksheet and assign the value in the descriptions category to an expense category and subcategory.

I am trying to find the matching description in a named range on Sheet8("Match") and then return the offset (1 column and 2 columns to the right of the match) to automatically populate the category and subcategory information.

I've put together the below code from some bits and pieces I've found online. However, the code only works ONCE. It returns the matching expense category and subcategory for the FIRST matching description in Range G13:G15, i.e., subsequent descriptions each have the same expense category/sub-category as the first item.

Any ideas on what I'm doing wrong?

Sub FindCategory()
     
    Dim rFound As Range
    Dim sFind As Range
    Dim sAddr As String
     
    Set sFind = ActiveSheet.Range("G13:G18")
    
    With Sheet8.Range("Match")
        Set rFound = .Find(What:=sFind, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
            If Not rFound Is Nothing Then
                sAddr = rFound.Address
                Do
                    sFind.Offset(0, 1).Value = rFound.Offset(0, 1)
                    sFind.Offset(0, 2).Value = rFound.Offset(0, 2)
                    Set rFound = .FindNext(rFound)
                Loop While rFound.Address <> sAddr
            End If
    End With
     
End Sub

6StringJazzer,

You have partially clarified my problem.
Range G13:G15 currently looks like this:

T-Mobile
CVS
Home Depot

So after I run the code I get:

T-Mobile Bills/Utilities Mobile Phone
CVS Bills/Utilities Mobile Phone
Home Depot Bills/Utilities Mobile Phone

So I think the problem I have is that find works on G13 and doesn't do a new find for G14 and G15. It it possible to Loop through all cells in a range and perform a find on each?

It's hard for me to understand the code you posted without seeing the context of how it's called. You can certainly loop through cells in a range but I don't know if the loop should be in FindCategory or the code that calls it. Can you post your whole file?

Here is how you loop through all cells in a range:

Dim c as Range
For Each c In ActiveSheet.Range("G13:G18")
   ' Do something here on the cell
Next c

Whew, I just got it working. Thanks for all the help.

I've changed things slightly since the first iteration. The idea now is to select the expense description and then the code will
1) checking for each cell within the selection
2) find a match (if one exists) in the named range "Match"
3) and return the offsets from match to the cell's right (returning both the expense category and subcategory)

I've posted the code below for anyone else who might be interested. 6String, please let me know if you see any issues/areas for improvement. And thanks again.

Sub FindCategory()
     
    Dim rFound As Range
    Dim sFind As Range
    Dim cell As Range
    Dim sAddr As String
     
    Set sFind = Selection
    
    For Each cell In sFind
        With Sheet8.Range("Match")
            Set rFound = .Find(What:=cell, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
                If Not rFound Is Nothing Then
                    sAddr = rFound.Address
                    Do
                        cell.Offset(0, 1).Value = rFound.Offset(0, 1)
                        cell.Offset(0, 2).Value = rFound.Offset(0, 2)
                        Set rFound = .FindNext(rFound)
                    Loop While rFound.Address <> sAddr
                End If
        End With
    Next
    
End Sub