Use AutoFilter on the current visible data

0 votes

To set Autofiler data on the currently active sheet, use the code below. It works, but all the concealed rows are shown once I run auto filter on any column. My goal is to set the filter on value and use a helper column. Thanks in advance for any assistance.

Option Explicit
Option Compare Text

    Sub AutoFilter_on_visible_data()
    
         Dim ws As Worksheet, arr, i As Long, lastR As Long, HdRng As Range, rng As Range
    
         Set ws = ThisWorkbook.ActiveSheet
         lastR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
          
         arr = ws.Range("A3:R" & lastR).Value2                          'Place the relevant columns in an array for faster iteration
         
          For i = 1 To UBound(arr)
          
            If ws.Rows(i + 2).Hidden = False Then                       '(i + 2) because Data starts at Row_3
            
                If Not arr(i, 2) Like "*Oil*" And _
                   Not arr(i, 5) Like "*-SYS-14" And _
                   Not arr(i, 6) Like "*Oil" Then
                   
                   addToRange HdRng, ws.Range("A" & i + 2)               'Make a union range of the rows NOT matching criteria...
                      
                End If
             End If
           Next i
           
          Application.ScreenUpdating = False
             If Not HdRng Is Nothing Then HdRng.EntireRow.Hidden = True      'Hide not matching criteria rows.
          Application.ScreenUpdating = True
    End Sub
    
    Private Sub addToRange(rngU As Range, rng As Range)
        If rngU Is Nothing Then
            Set rngU = rng
        Else
            Set rngU = Union(rngU, rng)
        End If
    End Sub 
Apr 10, 2023 in Others by narikkadan
• 63,420 points
271 views

1 answer to this question.

0 votes

Use the following modified code. It's assumed that the second row's headers are present:

Sub AutoFilter_on_visible_data()
         Dim ws As Worksheet, arr, i As Long, lastR As Long, lastCol As Long, arrH, rngH As Range, rng As Range
         Const helpH As String = "HelpColumn"
         
         Set ws = ThisWorkbook.ActiveSheet
         lastR = ws.Range("A" & ws.rows.count).End(xlUp).row
         lastCol = ws.cells(2, ws.Columns.count).End(xlToLeft).column 'last column, supposing that the header exists on the second row
         
         Set rngH = ws.rows(2).Find(what:=helpH, LookIn:=xlValues, Lookat:=xlWhole)
         If Not rngH Is Nothing Then  'if the helper header exists:
            lastCol = rngH.column
        Else                          'if not it is defined:
            lastCol = lastCol + 1
            ws.cells(2, lastCol).Value = helpH
        End If
        
        Set rng = ws.Range(ws.cells(2, 1), ws.cells(lastR, lastCol)) 'to use it for filterring
        
         If Not ws.AutoFilterMode Then rng.AutoFilter 'autofilter the resized range
        ws.AutoFilter.ShowAllData
        
         arr = ws.Range("A3:R" & lastR).Value2                      'Place the relevant columns in an array for faster iteration
         ReDim arrH(1 To UBound(arr), 1 To 1)
         
          For i = 1 To UBound(arr)
             If ws.rows(i + 2).Hidden = False Then                 '(i + 2) because Data starts at Row_3
            
                If Not arr(i, 2) Like "*Oil*" And _
                    Not arr(i, 5) Like "*-SYS-14" And _
                    Not arr(i, 6) Like "*Oil" Then
                   
                    arrH(i, 1) = "HH"                                        'Make a helper array to filter on it.
                   
                 End If
              End If
           Next i
           'Drop the arrH content at once:
           ws.cells(3, lastCol).Resize(UBound(arrH), 1).Value2 = arrH
           
           'Filter on the helper column:
           rng.AutoFilter field:=lastCol, Criteria1:="HH", Operator:=xlFilterValues
End Sub
answered Apr 10, 2023 by Kithuzzz
• 38,010 points

Related Questions In Others

+2 votes
2 answers
0 votes
1 answer

Excel VBA search based on cell values into folders and sub-folders to get the file path and data

This will create a listing of all ...READ MORE

answered Jan 19, 2023 in Others by narikkadan
• 63,420 points
1,608 views
0 votes
1 answer

How to multi level sort an array in excel, using formulas? I am aware about the way, using SORT button on DATA tab

Use SORTBY, e.g. =SORTBY(A2:B5,A2:A5,1,B2:B5,1) Or simply&nb ...READ MORE

answered Jan 22, 2023 in Others by narikkadan
• 63,420 points
296 views
0 votes
1 answer

How to expend the code to transfer data from one spreadsheet to another based on multiple criteria

 The progress bar is unnecessary. Option Explicit Sub VTest2() ...READ MORE

answered Jan 29, 2023 in Others by narikkadan
• 63,420 points
247 views
0 votes
1 answer

Copy the respective values from another workbook depend on specific conditions

Try this: Sub Get_Respective_Values_Of_Last_Closing_Date() Dim wb1 ...READ MORE

answered Feb 6, 2023 in Others by narikkadan
• 63,420 points
354 views
0 votes
1 answer

VBA How do I replace the range with an array in SUMIF

You can't, in my opinion. When you ...READ MORE

answered Feb 7, 2023 in Others by narikkadan
• 63,420 points
511 views
0 votes
1 answer

Excel VBA compare values on multiple rows and execute additional code

I would use a Dictionary & Collection ...READ MORE

answered Feb 7, 2023 in Others by narikkadan
• 63,420 points
1,368 views
0 votes
1 answer

How to concatenate elements of a single-dimensional array using VBA?

Using Microsoft 365's UNIQUE and SORT in VBA ' This is a ...READ MORE

answered Feb 16, 2023 in Others by narikkadan
• 63,420 points
363 views
0 votes
1 answer

Struggling to move object based on the value to respect sheet

If you are not moving many rows ...READ MORE

answered Feb 14, 2023 in Others by Kithuzzz
• 38,010 points
320 views
0 votes
1 answer

What VBA code would I use to concatenate cell A2 & B2 in cell C2 and then have it Autofill down the column?

Solution Find the last row. Write a formula to ...READ MORE

answered Feb 14, 2023 in Others by Kithuzzz
• 38,010 points
655 views
webinar REGISTER FOR FREE WEBINAR X
REGISTER NOW
webinar_success Thank you for registering Join Edureka Meetup community for 100+ Free Webinars each month JOIN MEETUP GROUP