VBA Delete Row if ....

[Pinaceous]

Hi All,

I'm working with a database where the first Column A's cell is not blank starting in row 11 of the worksheet.

I'm trying to create a Sub to delete the row if there are no values in the proceeding Column A.

For example, If Column A is not empty BUT its Columns B to AK are empty, the sub will delete that row.

Above there are values in Column A but if there are no values in that row from Columns B to AK, the sub will delete that row, as can be seen below.

So here the sub will delete the rows 15-16, 18-36 ...., because there were no values in that row from Columns B to AK, so the sub will delete that row.

Please let me know, if you can provide me with a sub to test out!

Thank you!
Pinaceous

 

[Cubist]

Try on a copy...

Sub ClearRowContentsIfBIsEmpty()
    Dim lastRow As Long
    Dim ws As Worksheet
    Dim cell As Range
    Dim rowsToClear As Range
    Dim clearCount As Long
   
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your sheet name

    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    For Each cell In ws.Range("A1:A" & lastRow)
        If IsEmpty(cell.Offset(0, 1)) Then

            If rowsToClear Is Nothing Then
                Set rowsToClear = cell.EntireRow
            Else
                Set rowsToClear = Union(rowsToClear, cell.EntireRow)
            End If
        End If
    Next cell

    If Not rowsToClear Is Nothing Then
        rowsToClear.ClearContents
    End If
End Sub

 

[Pinaceous]

Thank you Cubist!

I'll give it a try and appreciate that!

 

[Michael M]

Maybe this one as well, does the active sheet

Sub ClearRowContentsIfBIsEmpty()
Dim, r As Long
For r =Cells(Rows.Count, "A").End(xlUp).Row To 11 Step -1
    If WorksheetFunction.CountA(Range("A" & r & ":AK" & r)) = 1 Then Rows(r).Delete
Next r
End Sub

 

[Pinaceous]

Try on a copy...

Sub ClearRowContentsIfBIsEmpty()
    Dim lastRow As Long
    Dim ws As Worksheet
    Dim cell As Range
    Dim rowsToClear As Range
    Dim clearCount As Long
  
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your sheet name

    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    For Each cell In ws.Range("A1:A" & lastRow)
        If IsEmpty(cell.Offset(0, 1)) Then

            If rowsToClear Is Nothing Then
                Set rowsToClear = cell.EntireRow
            Else
                Set rowsToClear = Union(rowsToClear, cell.EntireRow)
            End If
        End If
    Next cell

    If Not rowsToClear Is Nothing Then
        rowsToClear.ClearContents
    End If
End Sub

Hey Cubist!

I'm testing out the code and I have a question.

Do you know if you can delete the row specifically between A:AI, only and not the entire length of the row as I previously mentioned?

Please let me know and thank you!
pinaceous

 

[Cubist]

Maybe this

Sub ClearRowContentsIfEmpty()
    Dim lastRow As Long
    Dim ws As Worksheet
    Dim r As Long
    Dim rowsToClear As Range
   
    Set ws = ThisWorkbook.Sheets("Sheet1")

    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    For r = 11 To lastRow
        If WorksheetFunction.CountA(ws.Range("A" & r & ":AI" & r)) = 1 Then
            If rowsToClear Is Nothing Then
                Set rowsToClear = ws.Rows(r)
            Else
                Set rowsToClear = Union(rowsToClear, ws.Rows(r))
            End If
        End If
    Next r

    If Not rowsToClear Is Nothing Then
        rowsToClear.Columns("A:AI").ClearContents
    End If
End Sub

 

[Pinaceous]

Maybe this

Sub ClearRowContentsIfEmpty()
    Dim lastRow As Long
    Dim ws As Worksheet
    Dim r As Long
    Dim rowsToClear As Range
 
    Set ws = ThisWorkbook.Sheets("Sheet1")

    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
 
    For r = 11 To lastRow
        If WorksheetFunction.CountA(ws.Range("A" & r & ":AI" & r)) = 1 Then
            If rowsToClear Is Nothing Then
                Set rowsToClear = ws.Rows(r)
            Else
                Set rowsToClear = Union(rowsToClear, ws.Rows(r))
            End If
        End If
    Next r

    If Not rowsToClear Is Nothing Then
        rowsToClear.Columns("A:AI").ClearContents
    End If
End Sub

Yes, this did the trick but I had to run this code several times for it to of worked upon the sheet.

Do you know, if you can modify this code to work once upon these values?

Thanks!

 

[Cubist]

Change the "Sheet1" to your sheet name

Set ws = ThisWorkbook.Sheets("Sheet1")

 

[Pinaceous]

Hi Cubist,

I mean that I have to run your code several times before I achieve the final result.

For example, Starting with the original "data" we have:

In running the code once it achieves:

In running the code a 2nd time it achieves:

In running the code a 3rd time it achieves:

Now my question is, how do I combine all of this work into one upon your code to work once?

Please let me know, if you need any further explanation.

Thank you very much!

R/
pinaceous

 

[Michael M]

Hi Pin
Did you try the code I posted ?
With regard to the code @Cubist posted, it will always have issues because you are running the loop from top to bottom, so it will skip rows when one is deleted. You must always loop from bottom to top when deleting rows