Home » excel » excel – Error 1004. Find loop continues to run. I'm moving text, so now it continues to run across worksheet

excel – Error 1004. Find loop continues to run. I'm moving text, so now it continues to run across worksheet

Posted by: admin May 14, 2020 Leave a comment

Questions:

This is part of a larger script to automate a very repetitive task.
This script is attempting to format each sheet so that data I’m pulling from a database can be pasted in correctly.

The code successfully creates a new column A.

Then all I am trying to do is find (in column B only) when a cell includes the word “Recommendation” then paste the information in cell.offset (-1,-1). This way the recommendation will now be in Column A next to the referred to Investment Strategy.

The moving of the Recommendation works (for all recommendations on the page).

I need the code to stop running after all the text has been moved.

There are likely better ways to write this and potentially other errors.

I think my script is searching the entire worksheet not just column B. The error occurs after the when Column B is finished and the macro moves to Column A (then tries to off set to -1,-1 which is off the page).

 Sub Adjust_Recommendations_EAFE()
'
'     Adjust_Recommendations EAFE Macro
'

'
 Sheets("EAFE").Select
 Range("A1").Select
 Range("A:A").Insert Shift:=xlToLeft, 
 Copyorigin:=xlFormatFromRightOrBelow


Dim rCell As Range
Dim rRng As Range
Dim Index As Variant


Set rRng = Range("B1:B1000")

 For Each rCell In rRng
 Cells.Find(What:="Recommendation", After:=ActiveCell, 
 LookIn:=xlFormulas, 
 LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, 
 MatchCase:=True).Select
        Debug.Print rCell.Address, rCell.Value

        If rCell Like "*Recommendation*" Then
        Selection.Copy
        ActiveCell.Offset(-1, -1).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
        SkipBlanks _:=False, Transpose:=False
        Application.CutCopyMode = False
        ActiveCell.Offset(1, 0).Select
        Selection.EntireRow.Delete

        End If




 Next rCell

 Sheets("Macro").Select

 End Sub
How to&Answers:

Try this. It would be worth you reading up on how to avoid Select.

Using Find you don’t have to loop through each cell, but you should always check that something is found before proceeding. Because you are deleting the cells you find the code loops until the term is not found any more in the range.

Sub Adjust_Recommendations_EAFE()

Dim rCell As Range
Dim rRng As Range

With Sheets("EAFE")
    .Range("A:A").Insert Shift:=xlToLeft, Copyorigin:=xlFormatFromRightOrBelow
    Set rRng = .Range("B1:B1000")
End With

Set rCell = rRng.Find(What:="Recommendation", LookIn:=xlFormulas, _
                     LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                     MatchCase:=True)
If Not rCell Is Nothing Then
    Do
        rCell.Offset(-1, -1).Value = rCell.Value
        rCell.EntireRow.Delete
        Set rCell = rRng.Find("Recommendation")
    Loop Until rCell Is Nothing
End If

End Sub