VBA Range.find errors (Not xlPart finding & Object variable not set error)

Question

I am a VBA beginner trying to re-purpose some code from a helpful contributor, I ran into a some trouble and am hoping you can help me out.

I have strings of comments in one sheet (DATA2) and keywords in another (KEYWORDS). My goal is to search through the comments and assign a category to them if one of the keywords is found.

The code below works as I would like on some values (Data = Eric Keyword = Eric). However, on other values an "Object variable not set" error is thrown, I assume because the value is not being found (Data=Ericlikespie Keyword = Eric OR Data=Emi No Keyword).

Any pointers would be helpful. I looked through previous answers but most seemed to be related to a range set issue. I realize that can do all this manually with conditional formatting or with a big index+search formula, but am looking for something better.

Sub Trail()

'DECS
Dim ws As Worksheet, Map As Worksheet
Dim MapRange As range, UpdateRange As range, aCell As range, bCell As range
On Error GoTo Err

'DEFS
Set ws = Worksheets("DATA2")
Set Map = Worksheets("KEYWORDS")
Set UpdateRange = ws.range("K:K")
Set MapRange = Map.range("A:A")

'COMPS
For Each aCell In UpdateRange
    Set bCell = MapRange.Find(What:=aCell, LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
    If Not bCell Is Nothing Then
        aCell.Offset(0, -1) = bCell.Offset(0, 1)
    End If
Next

Exit Sub
Err:
MsgBox Err.Description

End Sub

Answer 1

I solved the issue with the below code. The look-up table and the target table were switched in the Range.Find statement. This was causing exact matches to work, but partial (what I was going for) to fail, regardless of the code syntax.

I also added in a FindNext loop to search for all occurrences of each keyword, changed the error handling to deal with non-matches, and the code now runs as expected.

Private Sub CommandButton3_Click()


    Dim ws As Worksheet
    Dim DataRange As Range, UpdateRange As Range, aCell As Range, bCell As Range
    Dim cCell As Range
    Dim keeper As Range


    On Error Resume Next
    Set ws = Worksheets("Sheet1")
    Set UpdateRange = ws.Range("A1:A8")
    Set DataRange = ws.Range("H1:H4")

For Each aCell In DataRange
    Set bCell = UpdateRange.Find(What:=aCell.Value, LookIn:=xlValues, LookAt:= _
    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
    , SearchFormat:=False)

If Not bCell Is Nothing Then
    Set keeper = bCell
    bCell.Offset(0, 1) = aCell.Offset(0, 1)

        Do
            Set bCell = UpdateRange.FindNext(After:=bCell)

            If Not bCell Is Nothing Then
                If bCell.Address = keeper.Address Then Exit Do
                    bCell.Offset(0, 1) = aCell.Offset(0, 1)
            Else
                Exit Do
            End If

        Loop
Else
 ' MsgBox "Not Found"
  'Exit Sub

    End If
Next
Exit Sub
Err:
MsgBox Err.Description
End Sub

Answer 2

I think you meant to use

If Not bCell Is Nothing Then

rather than aCell, since the find is Set bCell = MapRange.Find ...