Trying to End Loop When it Errors Out

tcnt9176

Board Regular
Joined
Jun 23, 2008
Messages
223
I have a macro that loops the script below. It works fine it cannot find any more "***ERRROR*** b/c they are all deleted at the end. I am just trying to have the loop stop when it Errors out. The error is "Run-time error '91': Object variable or With block variable not set".



Sub TransposeLoop()
Application.ScreenUpdating = False
Do
Columns("A:A").Select
Selection.Find(What:="***ERROR***", After:=ActiveCell, LookIn:=xlFormulas _
, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Offset(0, 0).Select
Selection.ClearContents
Selection.End(xlUp).Select
Selection.CurrentRegion.Select
Selection.Copy
Sheets("Sheet2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(1, 0).Select
Sheets("Sheet1").Select
Range("A1").Select
Loop
Application.ScreenUpdating = True
End Sub
 

Some videos you may like

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

yytsunamiyy

Well-known Member
Joined
Mar 17, 2008
Messages
963
What is your code actually supposed to be doing? You can get rid of a lot of .select and .activate, as this is not usually necessary. If you give us an idea of what your sheet looks like anbd what you are trying to achieve we can help you tidying up your code. For now, to answer your question, a simple if...then solves your problem.

Code:
Sub TransposeLoop()
Application.ScreenUpdating = False
Do
   [COLOR=red] If Not Columns("A:A").Find(What:="***ERROR***", After:=ActiveCell, LookIn:=xlFormulas _
    , LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=True, SearchFormat:=False) Is Nothing Then
[/COLOR]        Columns("A:A").Find(What:="***ERROR***", After:=ActiveCell, LookIn:=xlFormulas _
        , LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=True, SearchFormat:=False).Activate
        ActiveCell.Offset(0, 0).Select
        Selection.ClearContents
        Selection.End(xlUp).Select
        Selection.CurrentRegion.Select
        Selection.Copy
        Sheets("Sheet2").Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
        Application.CutCopyMode = False
        ActiveCell.Offset(1, 0).Select
        ActiveCell.Offset(1, 0).Select
        Sheets("Sheet1").Select
        Range("A1").Select
    [COLOR=red]Else
        Exit Do
    End If
[/COLOR]Loop
Application.ScreenUpdating = True
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,122,233
Messages
5,594,963
Members
413,954
Latest member
mrsandy

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top