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
Try this. It would be worth you reading up on how to avoid Select.
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