thewindata

The Data –

I grabbed some NFL team data from Wikipedia for the current 32 teams in the NFL:

Make the 1D Array the Same Size as the 2D Array

 'Now that we know the size of the 2D array
 'We can resize the 1D array
        ReDim Criteria_1D(LBound(Criteria_2D) To UBound(Criteria_2D))

Load the 2D Array Into the 1D Array

Now that the 1D array is the same size as the 2D array, I can safely load the contents of the 2D array into the 1D array:

    'Load 2D array into 1D array
        For i = LBound(Criteria_2D, 1) To UBound(Criteria_2D, 1)
            Criteria_1D(i) = Criteria_2D(i, 1)
        Next i

Multiple Instances

My data only has 1 unique instance of team. What if there is more than 1 instance that I want to delete? No problem, the filter will show all instances of the criteria and once visible, the SpecialCells Method of the Range Object with the xlCellTypeVisible enumeration will handle all instances of the given criteria.

I made 9 additional copies of of the data for a total of 10 instances of each team giving a total of 320 records in the table.

There are 10 instances of each team and I want to delete 4 teams for a total of 40 records. When all is done and said I should have 280 records remaining.

The final data after running the procedure again to filter and delete all instances of the 4 teams. 280 records remain expected – sweet succeess!

The Main Procedure

Here’s the main procedure

Option Explicit

Sub FilterOutUnwantedValues()

    'Developer      :   Winston Snyder
    'Created Date   :   January 23, 2020
    'Purpose        :   Remove rows of data the user does not want in the final dataset
    'Comments       :

    'Objects
        Dim wb As Workbook
        Dim wsData As Worksheet
        Dim wsCrit As Worksheet

    'Variables
        Dim x As Long
        Dim r As Long
        Dim i As Long
        Dim Criteria_2D() As Variant
        Dim Criteria_1D() As String
        
    'Constants
        Const ColumNumber As Long = 1

    'Initialize
        Set wb = ThisWorkbook
        Set wsData = wb.Worksheets("Data")
        Set wsCrit = wb.Worksheets("crit")

    'Transfer criteria range to array
    'Use CurrentRegion Property of Range Object
        Criteria_2D = wsCrit.Range("A1").CurrentRegion

    'Now that we know the size of the 2D array
    'We can resize the 1D array
        ReDim Criteria_1D(LBound(Criteria_2D) To UBound(Criteria_2D))

    'Load 2D array into 1D array
        For i = LBound(Criteria_2D, 1) To UBound(Criteria_2D, 1)
            Criteria_1D(i) = Criteria_2D(i, 1)
        Next i

    'Check contents of 1D Array
        For i = LBound(Criteria_1D) To UBound(Criteria_1D)
            Debug.Print i, Criteria_1D(i)
        Next i

    'Call the filter function
    'Pass the array as the filter criteria
        x = GetFilterDeleteRows(ws:=wsData, _
                                FilterCriteria:=Criteria_1D, _
                                ColNumber:=ColumNumber)

    'Tidy up
        Erase Criteria_1D
        Erase Criteria_2D
        Set wsData = Nothing
        Set wsCrit = Nothing
        Set wb = Nothing

End Sub

The Filter and Delete Function

Here is the function to filter and delete the data

Option Explicit

Public Function GetFilterDeleteRows(ws As Worksheet, _
                                    FilterCriteria As Variant, _
                                    ColNumber As Long) As Long


    'Developer      :       Winston Snyder
    'Date           :       January 23, 2020
    'Purpose        :       Filter a range based on criteria in array
    '                       Once filtered, delete all visible rows except header row
    '
    'Paramers       :       ws              :   A worksheet object
    '               :       FilterCriteria  :   A one dimensional array of values to filter the data for
    '               :       ColNumber       :   The Column Number where the filter is to be applied
    '===================================================================================================

    'Objects
        Dim rng As Range
        Dim rngDelete As Range
        
    'Variables
        Dim i As Long
        
    'Initialize
        With ws
            Set rng = .Range("A1").CurrentRegion
        End With

    'Filter range based on criteria array
        rng.AutoFilter _
            Field:=ColNumber, _
            Criteria1:=FilterCriteria, _
            Operator:=xlFilterValues

    'Create a range object of all visible rows
    'Do not include the header row
        Set rngDelete = rng.Offset(1, 0) _
                           .Resize(rng.Rows.Count - 1, rng.Columns.Count) _
                           .SpecialCells(xlCellTypeVisible) _
                           .EntireRow

    'Delete all visible rows
    'Do not include the header row
        rngDelete.Delete

    'Remove the filter
        ws.ShowAllData
        ws.AutoFilterMode = False

    'Destroy objects
        Set rng = Nothing
        Set rngDelete = Nothing

    'Return
        GetFilterDeleteRows = 0

End Function

Tidy Up

That’s it for today. You can download the workbook from my OneDrive. Stay tuned for Part II. I’ll demonstrate some other options for filtering and deleting data.