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

Question

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

I believe you just need `rRng.Find(...)`. `Cells.Find` will look through *all* cells, as you suspected. But, you're looping through each cell in column B...so maybe just do `rCell.Find()` if you want to search that cell for the word. — BruceWayne, Aug 07 '19 at 14:48
What happens if it finds it in B1 - you can't go up one row from there? — SJR, Aug 07 '19 at 14:51
There is a header, so B1 is not possible (it will also be after an Investment Strategy) so B3 is the first possibility. I mean I get that someone could literally type that, but the data- how its coming in won't have it that way. — Cj17digr, Aug 07 '19 at 14:53
@BruceWayne. I get a run time 13 error based on that. I'm jumping on a conference call, I'll see if I can get that to work after. Thanks — Cj17digr, Aug 07 '19 at 14:57

SJR · Accepted Answer · 2019-08-07T16:39:11.180

2

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

edited Aug 07 '19 at 16:39

answered Aug 07 '19 at 15:07

SJR

22,986
6
18
26

The macro inserts 2 columns then ends. Don't we want if rCell is "Recommendation" then do? Also then offset isn't copying and pasting the recommendation. – Cj17digr Aug 07 '19 at 16:32
No, that's what `Find` does. Is it right that you are matching case? Sounds like you are not finding the text anywhere. – SJR Aug 07 '19 at 16:40
you were right. I edited your script. It's ALMOST there. It pastes "True" not the Recommendation. – Cj17digr Aug 07 '19 at 16:48
Don't understand that, it works for me. It should put the contents of the cell containing "Recommendation" one cell to the left and one row up. – SJR Aug 07 '19 at 16:51
When you say you edited it, what exactly did you do? – SJR Aug 07 '19 at 16:53
Not sure why - it works perfectly now. I literally love you. You don't know how much time I spent on this. – Cj17digr Aug 07 '19 at 16:54
Any recommendations for this off set? I'm going to run these again, to un adjust these changes? – Cj17digr Aug 07 '19 at 17:14
How do I write a script to exactly undo this process (for after I insert the updated data)? I hoped I'd be able to figure it out on my own, but I'm having difficulty. – Cj17digr Aug 07 '19 at 17:41
You have to think through the logical steps and reverse them, like a flow chart backwards. Find the text in column A, copy it one cell down and to the right and loop round. If you get stuck, post a new question with the code you've tried. – SJR Aug 07 '19 at 18:26

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

1 Answers1