删除所有包含指定数值范围之外的值的行

Question

I am completely new to visual basic. I have a few spreadsheets containing numbers. I want to delete any rows containing numbers outside of specific ranges. Is there a straightforward way of doing this in visual basic?

For example, in this first spreadsheet (image linked) I want to delete rows that contain cells with numbers outside of these two ranges: 60101-60501 and 74132-74532.

Can anyone give me some pointers? Thanks!

Answer 1

Code

You need to call it for your own needs as shown on the routine "Exec_DeleteRows". I assumed that you needed if it is equals or less to the one that you state on your routine. In this example, I will delete the rows where values are between 501-570 and then the ones between 100-200

Sub Exec_DeleteRows()
    Call Exec_DeleteRowsInRangeBasedOnNumberValue(Range("C8:H11"), 501, 570)
    Call Exec_DeleteRowsInRangeBasedOnNumberValue(Range("C8:H11"), 100, 200)
End Sub

Sub Exec_DeleteRowsInRangeBasedOnNumberValue(RangeToWorkIn As Range, NumPivotToDeleteRowBottom As Double, NumPivotToDeleteRowTop As Double)
Dim RangeRowsToDelete As Range
Dim ItemRange As Range
    For Each ItemRange In RangeToWorkIn
    If IsNumeric(ItemRange.Value) = False Then GoTo SkipStep1
    If ItemRange.Value >= NumPivotToDeleteRowBottom And ItemRange.Value <= NumPivotToDeleteRowTop Then ' 1. If ItemRange.Value >= NumPivotToDeleteRowBottom And ItemRange.Value <= NumPivotToDeleteRowTop
    If RangeRowsToDelete Is Nothing Then ' 2. If RangeRowsToDelete Is Nothing
    Set RangeRowsToDelete = RangeToWorkIn.Parent.Rows(ItemRange.Row)
    Else ' 2. If RangeRowsToDelete Is Nothing
    Set RangeRowsToDelete = Union(RangeToWorkIn.Parent.Rows(ItemRange.Row), RangeRowsToDelete)
    End If ' 2. If RangeRowsToDelete Is Nothing
    End If ' 1. If ItemRange.Value >= NumPivotToDeleteRowBottom And ItemRange.Value <= NumPivotToDeleteRowTop
SkipStep1:
    Next ItemRange
    If Not (RangeRowsToDelete Is Nothing) Then RangeRowsToDelete.EntireRow.Delete
End Sub

Demo

Answer 2

Delete Rows Containing Wrong Numbers

• It is assumed that the data starts in A1 of worksheet Sheet1 in the workbook containing this code ( ThisWorkbook ) and has a row of headers ( 2 ).
• This is just a basic example to get familiar with variables, data types, objects, loops, and If statements. It can be improved on multiple accounts.

Option Explicit

Sub DeleteWrongRows()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1") ' worksheet
    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion ' range
    
    Application.ScreenUpdating = False
    
    Dim rrg As Range ' Row Range
    Dim rCell As Range ' Cell in Row Range
    Dim rValue As Variant ' Value in Cell
    Dim r As Long ' Row
    Dim DoDelete As Boolean
    
    ' Loop backwards through the rows of the range.
    For r = rg.Rows.Count To 2 Step -1
        Set rrg = rg.Rows(r)
        ' Loop through cells in row.
        For Each rCell In rrg.Cells
            rValue = rCell.Value
            If IsNumeric(rValue) Then ' is a number
                If rValue >= 60101 And rValue <= 60501 Then ' keep
                ElseIf rValue >= 74132 And rValue <= 74532 Then ' keep
                Else ' delete (outside the number ranges)
                    DoDelete = True
                End If
            Else ' is not a number
                DoDelete = True
            End If
            If DoDelete Then ' found a cell containing a wrong value
                rCell.EntireRow.Delete
                DoDelete = False
                Exit For ' no need to check any more cells
            'Else ' found no cell containing a wrong value (do nothing)
            End If
        Next rCell
    Next r
    
    Application.ScreenUpdating = True
    
    MsgBox "Rows with wrong numbers deleted.", vbInformation
    
End Sub

Answer 3

Using Range.Delete is the built-in way of completely erasing a row in Excel VBA. To check an entire row for numbers meeting a certain criteria, you would need a Loop and an If Statement .

To evaluate a lot of values at a faster pace, it is smart to first grab the relevant data off the Excel sheet into an Array. Once in the array, it is easy to set up the loop to run from the first element ( LBound ) to the final element ( UBound ) for each row and column of the array.

Also, when deleting a lot of Ranges from a worksheet, it is faster and less messy to first collect ( Union ) the ranges while you're still looping, and then do the delete as a single step at the end. This way the Range addresses aren't changing during the loop and you don't need to re-adjust in order to track their new locations. That and we can save a lot of time since the application wants to pause and recalculate the sheet after every Deletion.

All of those ideas put together:

Sub Example()
    DeleteRowsOutside Min:=60101, Max:=60501, OnSheet:=ThisWorkbook.Worksheets("Sheet1")
    DeleteRowsOutside Min:=74132, Max:=74532, OnSheet:=ThisWorkbook.Worksheets("Sheet1")
End Sub
Sub DeleteRowsOutside(Min As Long, Max As Long, Optional OnSheet As Worksheet)
    If OnSheet Is Nothing Then Set OnSheet = ActiveSheet
    
    'Find the Bottom Corner of the sheet
    Dim BottomCorner As Range
    Set BottomCorner = OnSheet.Cells.Find("*", After:=OnSheet.Range("A1"), SearchDirection:=xlPrevious)
    If BottomCorner Is Nothing Then Exit Sub
    
    'Grab all values into an array
    Dim ValArr() As Variant
    ValArr = OnSheet.Range(OnSheet.Cells(1, 1), BottomCorner).Value
    
    'Check each row value against min & max
    Dim i As Long, j As Long, DeleteRows As Range
    For i = LBound(ValArr, 1) To UBound(ValArr, 1) 'For each Row
        For j = LBound(ValArr, 2) To UBound(ValArr, 2) 'For each column
            Dim v As Variant: v = ValArr(i, j)
            If IsNumeric(v) Then
                If v < Min Or v > Max Then
                    'v is outside the acceptable range! Mark row for deletion
                    If DeleteRows Is Nothing Then
                        Set DeleteRows = OnSheet.Rows(i)
                    Else
                        Set DeleteRows = Union(DeleteRows, OnSheet.Rows(i))
                    End If
                    Exit For 'skip to next row
                End If
            End If
        Next j
    Next i
    
    If Not DeleteRows Is Nothing Then DeleteRows.EntireRow.Delete
End Sub

Answer 4

Here's some code with Regex and with scripting dictionary that I've been working on. I made this for my purposes, but it may be useful here and to others.

I found a way for selecting noncontinguous cells based on an array and then deleting those cells.

In this case, I selected by row number because VBA prevented deletion of rows due to overlapping ranges.

Sub findvalues()

    Dim Reg_Exp, regexMatches, dict As Object
    Dim anArr As Variant
    Dim r As Range, rC As Range
    
    
    Set r = Sheets(3).UsedRange
    Set r = r.Offset(1).Resize(r.Rows.Count - 1, r.Columns.Count)
    Set Reg_Exp = CreateObject("vbscript.regexp")
    
    With Reg_Exp
            .Pattern = "^[6-6]?[0-0]?[1-5]?[0-0]?[1-1]?$|^60501$" 'This pattern is for the 60101 to 60501 range. 
    End With
     
     Set dict = CreateObject("Scripting.Dictionary")
        For Each rC In r
            If rC.Value = "" Then GoTo NextRC ''skip blanks
             Set regexMatches = Reg_Exp.Execute(rC.Value)
                If regexMatches.Count = 0 Then
                    On Error Resume Next
                       dict.Add rC.Row & ":" & rC.Row, 1
                End If
NextRC:
        Next rC
                    On Error GoTo 0

    anArr = Join(dict.Keys, ", ")
 
    Sheets(3).Range(anArr).Delete Shift:=xlShiftUp

End Sub