Which is Fast way to delete Blank and Zero values, records entire Rows?

[Guna13]

Hi Team,

In a specific sheet I have over 10000 records, and I need to delete "Blank" data in the "B" column, then delete entire rows the same way I delete "0" values.

Can you suggest any other method or VBA code to delete fast for this code? It takes a little bit of time to delete.

Trg.Columns("B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Trg.AutoFilterMode = False

Trg.Range("A1:B1000").AutoFilter Field:=2, Criteria1:="0"
  
  '2. Delete Rows
    Trg.Range("B2:B1000").SpecialCells(xlCellTypeVisible).Delete
  
  
  '3. Clear Filter
  On Error Resume Next
    Trg.AutoFilterMode = False
  On Error GoTo 0

 

[awoohaw]

For Blanks, Select the column, Press F5, click Special, select "Blanks", click OK, delete rows.

 

[Guna13]

Hi Awoohaw, I am need macro Code instead of Manual Delete Option, because this is one of the steps in my current macro project. Here I had stuck to get delay few minutes. Kindly advice.

 

[Peter_SSs]

Can you suggest any other method or VBA code to delete fast

Yes, try this. It does assume that column B can be used to determine the last row, which may not be correct since that could be blank. A slight tweak might be needed.
However, you should find this very fast.
Test with a copy of your data though in case something does go wrong.

Sub Del_Blank_and_0()
  Dim Trg As Worksheet
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long
  
  Set Trg = ActiveSheet '<- Perhaps you have a worksheet name instead?
  With Trg
    nc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    a = .Range("B2", .Range("B" & Rows.Count).End(xlUp)).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If a(i, 1) = "" Or a(i, 1) = 0 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 With
End Sub

 

[Guna13]

Yes, try this. It does assume that column B can be used to determine the last row, which may not be correct since that could be blank. A slight tweak might be needed.
However, you should find this very fast.
Test with a copy of your data though in case something does go wrong.

Sub Del_Blank_and_0()
  Dim Trg As Worksheet
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long
 
  Set Trg = ActiveSheet '<- Perhaps you have a worksheet name instead?
  With Trg
    nc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    a = .Range("B2", .Range("B" & Rows.Count).End(xlUp)).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If a(i, 1) = "" Or a(i, 1) = 0 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 With
End Sub

Great Thansk for your support

 

[Peter_SSs]

You're welcome. Thanks for the follow-up.

 

[awoohaw]

Hi Awoohaw, I am need macro Code instead of Manual Delete Option, because this is one of the steps in my current macro project. Here I had stuck to get delay few minutes. Kindly advice.

Sub deleterowswithblankcellsincolumnB()
'
' deleterowswithblankcellsincolumnB Macro
'

'
Columns("B:B").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
End Sub

 

[Guna13]

Sub deleterowswithblankcellsincolumnB()
'
' deleterowswithblankcellsincolumnB Macro
'

'
Columns("B:B").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
End Sub

Yes i tried this method, but little bit slow, not fast delete to more than 5000 blank rows..

 

[Guna13]

@Peter_SSs why this code does not support to delete "C" Column I have #/N/A lines. where I need to modify to this code. Appreciate your advance support

Sub Not_appl_Data_Delete()
  Dim Trg As Worksheet
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long
 
  Set Trg = ActiveSheet '<- Perhaps you have a worksheet name instead?
  With Trg
    nc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    a = .Range("C2", .Range("C" & Rows.Count).End(xlUp)).Value
    ReDim C(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If a(i, 1) = "#N/A" 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 With
End Sub

 

[Peter_SSs]

Not the cause of the error you reported, but would have subsequently caused a problem is that you have changed this from a 'b' in my code.

Try this to delete #N/A rows.

Sub Not_appl_Data_Delete()
  Dim Trg As Worksheet
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long
 
  Set Trg = ActiveSheet '<- Perhaps you have a worksheet name instead?
  With Trg
    nc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    a = .Range("C2", .Range("C" & Rows.Count).End(xlUp)).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If IsError(a(i, 1)) Then
        If a(i, 1) = CVErr(xlErrNA) Then
          b(i, 1) = 1
          k = k + 1
        End If
      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 With
End Sub