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
 

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
 

Forum statistics

Threads
1,085,337
Messages
5,383,041
Members
401,813
Latest member
Lucy_Wood

Some videos you may like

This Week's Hot Topics

Top