VBA to delete row based on criteria

biggmann

New Member
Joined
Oct 29, 2011
Messages
8
I am trying to wrote VBA code to delete rows if column "I" contains word Yes on sheet 1 I have named "Schedule". I have a button assigned to the macro I have and it does not show any errors but it will not delete anything. I was wondering if someone could look at this code and see why it isnt working.

Code:
Option Explicit
 

Sub Delete_Based_on_Criteria()

Dim X As Long
Dim Z As Long
Dim LastRow As Long
Dim FoundRowToDelete As Boolean
Dim OriginalCalculationMode As Long
Dim RowsToDelete As Range
Dim SearchItems() As String

Dim DataStartRow As Long
Dim SearchColumn As String
Dim SheetName As String



DataStartRow = 6
SearchColumn = "I"
SheetName = "Schedule"

SearchItems = Split("Yes", ",") 

On Error GoTo Whoops
OriginalCalculationMode = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

With Worksheets(SheetName)
LastRow = .Cells(.Rows.Count, SearchColumn).End(xlUp).Row
For X = LastRow To DataStartRow Step -1
FoundRowToDelete = False
For Z = 0 To UBound(SearchItems)
If InStr(.Cells(X, SearchColumn).Value, SearchItems(Z)) Then
FoundRowToDelete = True
Exit For
End If

Next

If FoundRowToDelete Then
If RowsToDelete Is Nothing Then
Set RowsToDelete = .Cells(X, SearchColumn)
Else
Set RowsToDelete = Union(RowsToDelete, .Cells(X, SearchColumn))
End If

If RowsToDelete.Areas.Count > 100 Then
RowsToDelete.EntireRow.Delete
Set RowsToDelete = Nothing
End If
End If

Next

End With
If Not RowsToDelete Is Nothing Then
RowsToDelete.EntireRow.Delete
End If

Whoops:
Application.Calculation = OriginalCalculationMode
Application.ScreenUpdating = True

 

End Sub
 

Some videos you may like

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off

b.downey

Active Member
Joined
Oct 16, 2011
Messages
484
The issue is with the "SearchItems" Variable. With the code you provided, the array will never have any data.

Change the following two lines:
Dim SearchItems() As String
SearchItems = Split("Yes", ",")

To the Following
Dim SearchItems as Variant
SearchItems = Array("Yes", "Test")

"Test" in the above line can have any seconday condition that you wish
 

biggmann

New Member
Joined
Oct 29, 2011
Messages
8
That worked, thanks for this I have been here for hours trying to find the error.
 

Trebor76

Well-known Member
Joined
Jul 23, 2007
Messages
4,714
Hi biggmann,

Welcome to the forum!!

There seems to be a lot of code for a straight forward need.

See how this goes (initially on a copy of your data in case the results are not as expected):

Code:
Option Explicit
Sub Delete_Based_on_Criteria()

    'http://www.mrexcel.com/forum/showthread.php?t=588713

    Dim lngRowStart As Long, _
        lngRowEnd As Long
    Dim strCol As String, _
        strSheetName As String
    
    lngRowStart = 6
    strCol = "I"
    strSheetName = "Schedule"
    
    Application.ScreenUpdating = False

    With Sheets(strSheetName)
        lngRowEnd = .Cells(Rows.Count, strCol).End(xlUp).Row
        If lngRowEnd > lngRowStart Then
            With .Range(strCol & lngRowStart & ":" & strCol & lngRowEnd)
                .Replace "Yes", "#N/A", xlWhole
                On Error Resume Next ' Account for no cells from the array being found.
                    .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
                On Error GoTo 0
            End With
        End If
    End With
    
    Application.ScreenUpdating = True

End Sub

HTH

Robert
 

Watch MrExcel Video

Forum statistics

Threads
1,123,489
Messages
5,601,986
Members
414,489
Latest member
Xlambda

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