Reputation: 74
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
Upvotes: 0
Views: 2327
Reputation: 74
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
Upvotes: 1
Reputation: 53136
I think you meant to use
If Not bCell Is Nothing Then
rather than aCell
, since the find is Set bCell = MapRange.Find ...
Upvotes: 1