Looping Error

[mcclanat]

Hello all,

I am having some trouble with a loop. I have a working macro that I am trying to add a little fuctionality too. The working macro finds a cell that meets a given criteria, then inserts a cell with a keyword two cells below the found cell. The functionality I am trying to add is to see if the keyword is already there by searching for the keyword between the found cell and first cell with two periods below the found cell. If the keyword is there, replace it with the new value. If not, then insert a cell with a keyword two cells below the found cell.

When I added the new fuctionality, I got an error that says "Object variable or With Block variable not set". It appears to be going into an infinate loop and gets stuck at the line of code that says

Loop While Not rFind Is Nothing And rFind.Address <> rFirst.Address

I have been messing with this for a couple hours and I can't see the problem. Both the working macro and the modified version are below and the spreadsheet is attached. Any help would be appreciated.

Thanks!

Working Macro:

Sub ActivityAssign()
Dim cell As Range, RNG As Range, rFind As Range, rFirst As Range
Dim txt1 As String, txt2 As String
Dim Keyword As String

Application.ScreenUpdating = False

txt1 = """ = SPACE"
txt2 = "Plnm"
Keyword = "C-ACTIVITY-DESC"
Set RNG = Sheets("Space Parameters").Range("Space_Find_Parameters").SpecialCells(xlConstants)

With Sheets("inp")
    For Each cell In RNG
        Set rFind = .Cells.Find(cell, After:=.Range("A" & .Rows.Count), LookIn:=xlValues, _
            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
            
        If Not rFind Is Nothing Then
            Set rFirst = rFind
    
            Do
                If InStr(rFind, txt2) = 0 And InStr(UCase(rFind), txt1) > 0 Then
                    rFind.Offset(2, 0).Insert xlShiftDown
                    rFind.Offset(2, 0).Value = "   " & Keyword & " = *" & cell.Offset(0, 1) & "*"
                End If
                
                Set rFind = .Cells.FindNext(rFind)
            Loop While Not rFind Is Nothing And rFind.Address <> rFirst.Address
        End If
                    Set rFirst = Nothing:   Set rFind = Nothing
                    
    Next cell
End With

Application.ScreenUpdating = True
End Sub

Modified Macro with Error:

Sub ActivityAssign2()
Dim cell As Range, RNG As Range, rFind As Range, rFirst As Range
Dim txt1 As String, txt2 As String
Dim SpcEnd As Range, SpcRng As Range, kFind As Range
Dim Keyword As String

Application.ScreenUpdating = False

txt1 = """ = SPACE"
txt2 = "Plnm"
Keyword = "C-ACTIVITY-DESC"

Set RNG = Sheets("Space Parameters").Range("Space_Find_Parameters").SpecialCells(xlConstants)

With Sheets("inp")
    For Each cell In RNG
        Set rFind = .Cells.Find(cell, After:=.Range("A" & .Rows.Count), LookIn:=xlValues, _
            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
            
        If Not rFind Is Nothing Then
            Set rFirst = rFind
    
            Do
                If InStr(rFind, txt2) = 0 And InStr(UCase(rFind), txt1) > 0 Then
                
                    Set SpcEnd = .Cells.Find(What:="..", After:=rFind, LookIn:=xlValues, LookAt:= _
                        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False _
                        , SearchFormat:=False)
                        
                    Set SpcRng = Range(rFind, SpcEnd)
                        
                    Set kFind = SpcRng.Find(What:=Keyword, After:=rFind, LookIn:=xlValues, LookAt:= _
                        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False _
                        , SearchFormat:=False)
                    
                        If Not kFind Is Nothing Then
                                kFind.Value = "   " & Keyword & " = *" & cell.Offset(0, 1) & "*"
                            Else:
                                rFind.Offset(2, 0).Insert xlShiftDown
                                rFind.Offset(2, 0).Value = "   " & Keyword & " = *" & cell.Offset(0, 1) & "*"
                        End If
                End If
                
                Set rFind = .Cells.FindNext(rFind)
                
            'Getting Loop error here
            Loop While Not rFind Is Nothing And rFind.Address <> rFirst.Address
        End If
                    Set rFirst = Nothing:   Set rFind = Nothing
                    
    Next cell
End With

Application.ScreenUpdating = True
End Sub