Delete whole row if the cell in the column is blank [VBA]

Martin_H

Board Regular
Joined
Aug 26, 2020
Messages
180
Office Version
  1. 2016
Platform
  1. Windows
Hi,

I have been using this code to delete whole row if the cell in the column G is blank.

VBA Code:
Sub DELETE_BLANKS()

Application.ScreenUpdating = False

Columns("G:G").SpecialCells(xlCellTypeBlanks).EntireRow.DELETE

Application.ScreenUpdating = True

End Sub

I have been using this macro to clean up worksheets with thousands of rows. It works well, but It takes a few minutes to run.

Is there any faster way to do the same job?

Help is much appreciated.

Many thanks.
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
3,437
Office Version
  1. 365
Platform
  1. Windows
Try adding code at the start of the macro to sort the data so that the blank cells are at the bottom.
If you need help adding the code to do this, post again.
 

Martin_H

Board Regular
Joined
Aug 26, 2020
Messages
180
Office Version
  1. 2016
Platform
  1. Windows
Thanks for the reply footoo, I would like to see your code.
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
56,526
Office Version
  1. 365
Platform
  1. Windows
Give this a try with a copy of your data.
I have assumed headers in row 1.

VBA Code:
Sub Del_Rows()
  Dim a As Variant, b As Variant
  Dim nc As Long, lr As Long, i As Long, k As Long
 
  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  lr = Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  a = Range("G2:G" & lr).Value2
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If IsEmpty(a(i, 1)) Then
      b(i, 1) = 1
      k = k + 1
    End If
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A2").Resize(UBound(a), nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub
 

Martin_H

Board Regular
Joined
Aug 26, 2020
Messages
180
Office Version
  1. 2016
Platform
  1. Windows
Hi Peter, thank you for your reply.

Well there are no actual headers. It is a messy worksheet like a Swiss cheese with a lot of blank rows and columns.
 

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
3,437
Office Version
  1. 365
Platform
  1. Windows
Peter_SSs's code should a bit quicker, but you could try this :
VBA Code:
Sub Del_Rows()
Dim nc As Long, lr As Long
nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
lr = Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Application.ScreenUpdating = False
With Range(Cells(1, nc), Cells(lr, nc))
    .Formula = "=IF(G1="""",""d"",1)"
    .EntireRow.Sort Key1:=Columns(nc), Order1:=xlAscending, Header:=xlNo
End With
Columns(nc).Delete
[G:G].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
 
Last edited:

Martin_H

Board Regular
Joined
Aug 26, 2020
Messages
180
Office Version
  1. 2016
Platform
  1. Windows
Peter_SSs's code should a bit quicker, but you could try this :
VBA Code:
Sub Del_Rows()
Dim nc As Long, lr As Long
nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
lr = Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Application.ScreenUpdating = False
With Range(Cells(1, nc), Cells(lr, nc))
    .Formula = "=IF(G1="""",""d"",1)"
    .EntireRow.Sort Key1:=Columns(nc), Order1:=xlAscending, Header:=xlNo
End With
Columns(nc).Delete
[G:G].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Thank you for your reply footoo.

Macro worked but it took way longer than the original one.
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
56,526
Office Version
  1. 365
Platform
  1. Windows
Well there are no actual headers.
Then there are just a couple of small changes.

VBA Code:
Sub Del_Rows_v2()
  Dim a As Variant, b As Variant
  Dim nc As Long, lr As Long, i As Long, k As Long
 
  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  lr = Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  a = Range("G1:G" & lr).Value2
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If IsEmpty(a(i, 1)) Then
      b(i, 1) = 1
      k = k + 1
    End If
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A1").Resize(UBound(a), nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub
 

Martin_H

Board Regular
Joined
Aug 26, 2020
Messages
180
Office Version
  1. 2016
Platform
  1. Windows
Then there are just a couple of small changes.

VBA Code:
Sub Del_Rows_v2()
  Dim a As Variant, b As Variant
  Dim nc As Long, lr As Long, i As Long, k As Long
 
  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  lr = Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  a = Range("G1:G" & lr).Value2
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If IsEmpty(a(i, 1)) Then
      b(i, 1) = 1
      k = k + 1
    End If
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A1").Resize(UBound(a), nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub
Worked!

Original code took more than 150 seconds.

With footoo's code it took aprox 18 seconds.
With Peter's code it took aprox 16 seconds.

Awesome guys! You saved me a lot of time.

Thank you very much. Much appreciated.
 

Forum statistics

Threads
1,175,833
Messages
5,899,728
Members
434,797
Latest member
natejxoticpc

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top