Loop Row Deletion

[chirayu]

Hi All,

This is more of a random question. I tend to use Do Until more than For Loops. I wanted to know how I would do something like the below using a For Loop

Do Until IsEmpty(ActiveCell)
    If Something Then
        'Do Something
        'Delete Current Row
    ElseIf Nothing Then
        'Select Next Row
    Else
   End If
Loop

I end up skipping stuff I don't want to if I use FOR LOOP as it moved to NEXT. rather than figuring out where the new row actually is after deletion

 

[SirJB7]

Hi, chirayu!
Does this help?

Option Explicit

Sub x()
    Do Until IsEmpty(ActiveCell)
        Debug.Print ActiveCell.Address
        If Val(ActiveCell.Value) > 0 Then
            ActiveCell.EntireRow.Delete xlDown
        Else
            ActiveCell.Offset(1, 0).Select
        End If
    Loop
End Sub

Sub y()
    Dim I As Long
    With ActiveCell.CurrentRegion
        Debug.Print .Address
        For I = .Rows.Count To 1 Step -1
            If Val(.Cells(1, 1).Value) > 0 Then
                .Rows(I).EntireRow.Delete xlDown
            End If
        Next I
    End With
End Sub

Regards!

 

[chirayu]

How would I modify this one to use FOR LOOP. the "Delete duplicate rows... Go Back to next row" argument

Sub DO_UNTIL_LOOP()

'Define Variables
Dim StRow As Integer
Dim EndRow As Integer
Dim Val As String

'Loop Start
Range("A2").Select

Do Until IsEmpty(ActiveCell)
   
    'Figure out first & last row for concatenate
    StRow = ActiveCell.Row
    Do Until ActiveCell = ActiveCell.Offset(1, 0).Select
        ActiveCell.Offset(1, 0).Select
    Loop
    EndRow = ActiveCell.Row
   
    'Copy data to new range
    Range("B" & StRow & ":B" & EndRow).Copy
    Range("T1").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
   
    'Remove duplicates
    Range("T:T").RemoveDuplicates 1, xlNo
   
    'Concatenate
    Range("T1").Select
    Val = ActiveCell
    Do Until IsEmpty(ActiveCell)
        ActiveCell.Offset(1, 0).Select
        If Not IsEmpty(ActiveCell) Then Val = Val & ", " & ActiveCell
    Loop
    Range("T:T").ClearContents
   
    'Paste back to StRow
    Range("B" & StRow) = Val
   
    'Delete duplicate rows
    Range("A" & StRow + 1 & "A" & EndRow).EntireRow.Delete
   
    'Go back to next row
    Range("A" & StRow + 1).Select
   
Loop


End Sub

 

[SirJB7]

Hi, chirayu!
Give this a try:

Option Explicit

Sub DO_UNTIL_LOOP()

'Define Variables
Dim StRow As Integer
Dim EndRow As Integer
Dim Val As String
'-----
Dim I As Integer
'-----

'Loop Start
Range("A2").Select

Do Until IsEmpty(ActiveCell)
   
    'Figure out first & last row for concatenate
   StRow = ActiveCell.Row
    Do Until ActiveCell = ActiveCell.Offset(1, 0).Select
        ActiveCell.Offset(1, 0).Select
    Loop
    EndRow = ActiveCell.Row
   
    '-----
    'Figure out first & last row for concatenate
    StRow = ActiveCell.Row
    EndRow = ActiveCell.End(xlDown).Row
    '-----
   
    'Copy data to new range
   Range("B" & StRow & ":B" & EndRow).Copy
    Range("T1").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
   
    'Remove duplicates
   Range("T:T").RemoveDuplicates 1, xlNo
   
    'Concatenate
   Range("T1").Select
    Val = ActiveCell
    Do Until IsEmpty(ActiveCell)
        ActiveCell.Offset(1, 0).Select
        If Not IsEmpty(ActiveCell) Then Val = Val & ", " & ActiveCell
    Loop
    Range("T:T").ClearContents
   
    '-----
    'Concatenate
    [T1].Select
    Val = CStr(ActiveCell.Value)
    StRow = ActiveCell.Row
    EndRow = ActiveCell.End(xlDown).Row
    For I = StRow To EndRow
        Val = Val & ", " & Range("T" & CStr(I)).Value
    Next I
    '-----
   
    'Paste back to StRow
   Range("B" & StRow) = Val
   
    'Delete duplicate rows
   Range("A" & StRow + 1 & "A" & EndRow).EntireRow.Delete
   
    'Go back to next row
   Range("A" & StRow + 1).Select
   
Loop


End Sub

Changes has this format:
'-----
xxxxxx
'-----

Regards!