Do Until loop while active ce

[drose1105]

I am trying to find the #1 in a column and perform a specific function if the active cell = 1 (it also deletes the entire row where there is the #1) for an entire column (called "temp"). I am then continuing to find the #1 by looping until active cell = blank.
The issue I have is that when all #1's have been deleted, in the temp column, I receive a macro error as it can't find the #1 anymore.

How do I resolve this error?

Sub finduntilnomore1() Rows("1:1").Select Selection.Find(What:="temp").Activate ActiveCell.Offset(1, 0).Activate Do Until ActiveCell = "" Cells.Find(What:="1", After:=ActiveCell, LookIn:=xlValues, LookAt:= _ xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _ False, SearchFormat:=False).Activate ActiveCell.Offset(0, 2).Select Range(ActiveCell, ActiveCell.Offset(0, 1)).Select Selection.Cut ActiveCell.Offset(-1, 0).Select ActiveSheet.Paste ActiveCell.Offset(1, 0).Select Selection.EntireRow.Delete ActiveCell.Offset(0, -2).Activate Loop End Sub

 

[Joe4]

Welcome to the Board!

It is generally a bad idea to use ActiveCell and Selection in loops. And using those commands is unnecessary and actually slows your code down.
You usually do not need to select the ranges to work with them.
When deleting or inserting data in a range, it is usually best to loop through the range backwards, to ensure that nothing gets missed.

See if this code does what you want:

Sub MyMacro()

    Dim c As Long
    Dim r As Long
    Dim lr As Long
    
    Application.ScreenUpdating = False
    
'   Find column in row 1 with "temp" in it
    c = Rows("1:1").Find(What:="temp").Column
    
'   Find last row in "temp" column with data
    lr = Cells(Rows.Count, c).End(xlUp).Row
        
'   Loop through rows backwards, up to row 3
    For r = lr To 3 Step -1
'       See if value in temp column is 1
        If Cells(r, c).Value = 1 Then
'           Cut value from columns 2 and 3 ocver to line above
            Range(Cells(r, c + 2), Cells(r, c + 3)).Cut Cells(r - 1, c + 2)
'           Delete row
            Rows(r).Delete
        End If
    Next r

    Application.ScreenUpdating = True

End Sub

 

[drose1105]

Welcome to the Board!

It is generally a bad idea to use ActiveCell and Selection in loops. And using those commands is unnecessary and actually slows your code down.
You usually do not need to select the ranges to work with them.
When deleting or inserting data in a range, it is usually best to loop through the range backwards, to ensure that nothing gets missed.

See if this code does what you want:

Sub MyMacro()

    Dim c As Long
    Dim r As Long
    Dim lr As Long
   
    Application.ScreenUpdating = False
   
'   Find column in row 1 with "temp" in it
    c = Rows("1:1").Find(What:="temp").Column
   
'   Find last row in "temp" column with data
    lr = Cells(Rows.Count, c).End(xlUp).Row
       
'   Loop through rows backwards, up to row 3
    For r = lr To 3 Step -1
'       See if value in temp column is 1
        If Cells(r, c).Value = 1 Then
'           Cut value from columns 2 and 3 ocver to line above
            Range(Cells(r, c + 2), Cells(r, c + 3)).Cut Cells(r - 1, c + 2)
'           Delete row
            Rows(r).Delete
        End If
    Next r

    Application.ScreenUpdating = True

End Sub

This works perfectly. Thanks so much!!

 

[Joe4]

You are welcome!

I hope it all makes sense.
Let me know if you ahve any questions about any of the code.