Recently, I was working with Oracle Business Intelligence Enterprise Edition (OBIEE) using the Smart View Add-In for Excel. I noticed that at times after ZoomIn to bottom level (Zoom Level =2) Child Level account from a Top Level Parent Account, I was left with a few Sub-total Accounts that I did not want in my final table. I decided that the best approach was to filter the data for the unwanted G/L’s and delete the visible rows. This is a good dynamic approach so that if the list expands or contracts in the future, the user can easily maintain the list on a worksheet that is read into the array that will be passed to the filter as the criteria.

The Data –

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

And I added a second sheet to use to list the criteria I want to load into the array to be used to filter the first sheet

I listed the 4 teams from the NFC East (Least). I’ll remove these teams from the list since they were all terrible teams in 2019.

Code

The full code is at the bottom, but there are a few code blocks I want look at specifically

Load Criteria Array from Worksheet Range

The Range in this case is very straightforward. It is a list that begins in A1 and continues down column A with no blanks. Therefore, I can use the CurrentRegion property of the Range Object to load the worksheet range to the criteria array. If you have a more complex range, you will need to update this piece of code.

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

Since I transferred a worksheet range to an array- the array now has 2 dimensions where the rows are the 1st dimension and the columns are the 2nd dimension. Let see what happens when I try to use this array as the criteria for the filter:

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

There are still 31 teams in the table. I have 4 teams listed on the criteria sheet, so there should only be 28 teams showing. With the 2D array the only team deleted was the Dallas Cowboys, the first team listed on the criteria sheet. To get all of the teams on the criteria sheet, I am going to have to convert the array from 2 dimensions to 1 dimension.

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

I’ll start the conversion process by making sure the 1D array is the same size as the 2D array for the rows part of the 2D array. Use the ReDim statement:

 '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

Filter and Delete Data Based on Criteria Array

Now that I have the criteria loaded into the 1D array, I can pass the array to my function to filter the data and delete the visible rows after the filter:

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

Filter Data

This code chunk will filter the data based on the criteria array. I see that the team name I am filtering for is in Column A (Field Number 1) so I passed “1” to the function. There are other, better ways to find the position of the field to make the code more dynamic in case the column containing the team name were to move:

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

Delete Visible Rows Except Header Row

This bit of code will delete the visible rows based on the criteria I filtered for. Note that I use the Resize Property of the Range Object so that the header row is not deleted. Again, simply passing Field Number as “1”.

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

Now that I have the array with 1 dimension as the filter criteria, I am getting the correct expected results. The 4 teams from the NFC East have been deleted leaving 28 teams.

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.

, , , , ,
Trackback

no comment untill now

Add your comment now