Help on making this code Run faster, Takes like a minute

[DarrenBurke]

Hi, Guys and gals,
Can i tweak this code to run faster.
What are you trying to do ? I want the code to check colum "A" for empty cells and delete the entire row. (Basically the telesales did not capture the correct info, therefore the row of info is useless and needs to be deleted. ) It works as is but takes a long time to finish. I have 10 other sheets to apply it to with a macro on each sheet. Thank you to the Hive Minds

Sub Delete_Rows_with_Blank_Cells_in_Single_Column()

Worksheets("MichaelF").Activate

Set Rng = ActiveSheet.UsedRange

Blank_Cells_Column = 1

For i = Rng.Rows.Count To 1 Step -1
    If Rng.Cells(i, Blank_Cells_Column) = "" Then
        Rng.Cells(i, Blank_Cells_Column).EntireRow.Delete
    End If
Next i
   
End Sub

I hope i did the code correctly

Cheers

 

[Fluff]

Hi & welcome to MrExcel.
How about

Sub DarrenBurke()
   Range("A:A").SpecialCells(xlBlanks).EntireRow.Delete
End Sub

 

[DarrenBurke]

Hi & welcome to MrExcel.
How about

Sub DarrenBurke()
   Range("A:A").SpecialCells(xlBlanks).EntireRow.Delete
End Sub

Hi Fluff, thank you for the speedy response, i get a 1004 runtime error, please see attachment Snapshot. Thank you for your time.

 

[Alex Blakenburg]

Do you have formulas in Column A returning "" ?
You will only get that error is there are no empty cells.

 

[Fluff]

Ok, it looks like you are using a table which is causing the problem, what is the name of the table?

 

[Peter_SSs]

Give this a try with a copy of your workbook.
I have assumed just one ListObject (formal table) on the sheet.

Sub Del_Rws()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long, Blank_Cells_Column As Long
  
  Blank_Cells_Column = 1
  
  With Sheets("MichaelF").ListObjects(1)
    a = .DataBodyRange.Columns(Blank_Cells_Column).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If Len(a(i, 1)) = 0 Then
        b(i, 1) = 1
        k = k + 1
      End If
    Next i
    If k > 0 Then
      Application.ScreenUpdating = False
      .ListColumns.Add
      With .DataBodyRange
        nc = .Columns.Count
        .Columns(nc).Value = b
        .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlYes
        .Resize(k).EntireRow.Delete
      End With
      .ListColumns(nc).Delete
      Application.ScreenUpdating = True
    End If
  End With
End Sub

 

[DarrenBurke]

Ok, it looks like you are using a table which is causing the problem, what is the name of the table?

Ok Well spotted Fluff. This table has a data connection to source file it updates on open bringing any new data. 3 captures per A4 page, the have not completed the other 2, thefore 2 blanks.
Table name is Table_Michael_Pickup attached snapshot

 

[Fluff]

Ok, give Peter's code a go, if you have a lot of data it will be faster than what I suggested.

 

[DarrenBurke]

Give this a try with a copy of your workbook.
I have assumed just one ListObject (formal table) on the sheet.

Sub Del_Rws()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long, Blank_Cells_Column As Long
 
  Blank_Cells_Column = 1
 
  With Sheets("MichaelF").ListObjects(1)
    a = .DataBodyRange.Columns(Blank_Cells_Column).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If Len(a(i, 1)) = 0 Then
        b(i, 1) = 1
        k = k + 1
      End If
    Next i
    If k > 0 Then
      Application.ScreenUpdating = False
      .ListColumns.Add
      With .DataBodyRange
        nc = .Columns.Count
        .Columns(nc).Value = b
        .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlYes
        .Resize(k).EntireRow.Delete
      End With
      .ListColumns(nc).Delete
      Application.ScreenUpdating = True
    End If
  End With
End Sub

Thank you so much Peter it works in milliseconds.... WOW!!
Thank you Fluff, Both Champions
Cheers from a chilly South Africa

 

[Fluff]

Glad we could help & thanks for the feedback.