Trying to End Loop When it Errors Out

[tcnt9176]

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]

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.

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

 

[tcnt9176]

that worked perfectly!!! thanks so much!!!