How to code VBA to delete row with value >0

malavp552

New Member
Joined
Jun 24, 2021
Messages
1
Office Version
  1. 365
Platform
  1. Windows
Hi,

I am looking to delete any row that contains a value above 0 in column I.

I have a code here but I cant seem to change the value looked for into a number.

VBA Code:
Sub Testdelete1()

Application.ScreenUpdating = False
Dim LastRow As Long
Dim c As Long
Dim s As Variant
c = 10
s = "Not Approved" '
LastRow = Cells(Rows.Count, c).End(xlUp).Row

With ActiveSheet.Cells(1, c).Resize(LastRow)
    .AutoFilter 1, s
    counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
    If counter > 1 Then
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    Else
        MsgBox "No values found"
    End If
    .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

Thanks,
Malav
 
Last edited by a moderator:

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

JackDanIce

Well-known Member
Joined
Feb 3, 2010
Messages
9,890
Office Version
  1. 365
Platform
  1. Windows
Try
VBA Code:
Sub malavp552()

    Dim x As Long
    Dim c As Long
    
    Application.ScreenUpdating = False
        
    With ActiveSheet
    
        x = .Cells(.Rows.Count, 10).End(xlUp).Row
        With .Cells(1, 8).Resize(x, 3)
            .Cells(1, 3).AutoFilter 3, "Not Approved", xlAnd
            .Cells(1, 1).AutoFilter 1, ">0", xlAnd
        End With
        
        On Error Resume Next
        With .Cells(2, 10).Resize(x - 1).SpecialCells(xlCellTypeVisible)
            c = .Count
            If c Then
                .EntireRow.Delete
            Else
                MsgBox "No values found", vbExclamation, "No Values Found"
            End If
        End With
        On Error GoTo 0
        
    End With
    
    Application.ScreenUpdating = True
        
End Sub
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
51,847
Office Version
  1. 365
Platform
  1. Windows
Welcome to the MrExcel board!

When posting vba code, please use code tags to preserve the indentation to make the code easier to read/debug. My signature block below has more details. I fixed it for you this time.

If you happen to have large data and numerous disjoint rows that meet the deletion criteria, then this will be much faster than an AutoFilter Method.
We have not seen any of your data so note that at present this code is case-specific in column 10 (that is "not approved" would not meet the criteria) and if it is possible that any cells in column I contain text they would meet the ">1" criteria. Both of these issues can be addressed if required and we know the details of what your data is, or could be, like.

Test with a copy of your workbook.

VBA Code:
Sub Del_Not_Approved_Greater_Than_1()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long
 
  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  a = Range("I2", Range("J" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If a(i, 2) = "Not Approved" Then
      If a(i, 1) > 1 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 Sub

If I misinterpreted your request and it is only column I greater than 1 that you want to delete rows for then try:
(Same issue with text values)

VBA Code:
Sub Del_Greater_Than_1()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long
 
  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  a = Range("I2", Range("I" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If a(i, 1) > 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
 

Forum statistics

Threads
1,148,257
Messages
5,745,704
Members
423,968
Latest member
CHHeights

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