'Delete entire rows except one column in a loop

How do I delete an entire row except column I in a loop?

Set rng_dest = Sheets("Database1").Range("B:K")
Do Until Sheets("Database1").Range("A" & i).Value = ""
    If Sheets("Database1").Range("A" & i ).Value = Sheets("Report1").Range("Q5").Value Then
        Sheets("Database1").Range("A" & i).Entire row.Delete
        i = 1
    End If
    i = i + 1
Loop

excel vba

Solution 1:^[1]

Store Column I before clearing the row and then write it back.

Option Explicit
Sub ClearRows()

    Dim v, tmp
    Dim i As Long, lastrow As Long, n As Long
    
    v = Sheets("Report1").Range("Q5").Value
    With Sheets("Database1")
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 1 To lastrow
            If .Cells(i, "A") = v Then
                tmp = .Cells(i, "I")
                .Rows(i).ClearContents
                .Cells(i, "I") = tmp
                n = n + 1
            End If
        Next
    End With
    MsgBox n & " rows cleared that matched '" & v & "'", vbInformation
    
End Sub

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution	Source
Solution 1	CDP1802

'Delete entire rows except one column in a loop

Solution 1:[1]

Sources

Related Questions

Solution 1:^[1]