Delete all rows containing values outside of a specified numeric range-CodePudding

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!

CodePudding user response：

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

CodePudding user response：

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

CodePudding user response：

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 ThisWorkbook.Worksheets("Sheet1"), Array(60101, 60501), Array(74132, 74532)
End Sub
Sub DeleteRowsOutside(OnSheet As Worksheet, ParamArray Min_and_Max() As Variant)
    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
                Dim BoundaryPair As Variant, Is_Within_A_Boundary As Boolean
                Is_Within_A_Boundary = False 'default value
                For Each BoundaryPair In Min_and_Max
                    If v >= BoundaryPair(0) And v <= BoundaryPair(1) Then
                        Is_Within_A_Boundary = True
                        Exit For
                    End If
                Next BoundaryPair
                
                If Not Is_Within_A_Boundary Then
                    'v is not within any acceptable ranges! Mark row for deletion
                    If DeleteRows Is Nothing Then
                        Set DeleteRows = OnSheet.Rows(i)
                    Else
                        Set DeleteRows = Union(DeleteRows, OnSheet.Rows(i))
                    End If
                    GoTo NextRow 'skip to next row
                End If
            End If
        Next j
NextRow:
    Next i
    
    If Not DeleteRows Is Nothing Then DeleteRows.EntireRow.Delete
End Sub         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

I use a ParamArray to accept a variable number of Min and Max ranges. To keep things tidy, the Min and Max pairs are each in an array of their own. As long as all the numbers in the row are within any of the provided ranges, the row will not be deleted.