Multi Range, Multi Criteria Search VBA - Hide/Unhide Columns

[J_Raab]

Hi All,

Have a worksheet with a lot of data and I'm building a search VBA that hides/unhides columns based on 2 cells containing user entered data (from drop down menus). The first "For" function works without a problem, its easy since it's reading from a range with a single row, the second parameter is what's sticking me and i just can't get it to work no matter what I use.

The worksheet lists employee names (I1:UD1) with the corresponding columns listing the employee details: employee divisions (Div = Range("I2:UD2") ); Union trade classification (Class= Range("I8:UD109") ) etc..

"Class" is large since employees can have multiple classifications depending on the state/county (Maryland - Master, DC - Journeyman, Harford County- Journeyman etc.). I want the VBA to run through both parameters and hide the columns that don't meet the criteria in DivS =Range("B2") and ClassS =Range("B4"). But the Class search has to identify if the employee has that parameter listed ANYWHERE in that column and leave it unhidden. So if an employee is a Journeyman in MD but a Master in DC, and we search for "Master" that column stays unhidden, since the parameter is found in the corresponding column

I tried to do a .find in the If..Then..Else but it never functioned properly, I got the .find to work on it's own but never when I added code for a specific division.

I'm trying to do the following with the attached code, ANY help at all would be appreciated, either using what I have or teaching me a simpler way.

DivS and ClassS = "All" - All columns show (this works)
DivS= User Entry ; ClassS ="All" - Proper columns show (this works)
DivS = User Entry ; ClassS = User entry - Show only columns that meet that criteria (doesn't work at all)
DivS="All" ; ClassS = User Entry - Show only columns that meet the criteria (doesn't work at all)

'Search


Dim cell As Range
Dim trade As Range

Dim Div As Range
Set Div = Range("I2:UD2") 'Range to search for Division (DivS)


Dim DivS As Range
Set DivS = Range("B2") 'User entered drop down menu - used as Search parameter for Div


Dim Class As Range
Set Class = Range("I8:UD109") 'Range to search for Union Trade (ClassS)


Dim ClassS As Range
Set ClassS = Range("B4") 'User entered drop down menu - used as Search parameter for Class


For Each cell In Div


'All Divisions, All Classes
If DivS.Value = "All" And ClassS = "All" Then
cell.EntireColumn.Hidden = False


'Division specific, All Classes
ElseIf DivS.Value <> "All" And cell.Value <> DivS.Value Then
cell.EntireColumn.Hidden = True
ElseIf DivS.Value <> "All" And cell.Value = DivS.Value Then
cell.EntireColumn.Hidden = False
End If
Next cell

'Tried to build code that would get the ClassS parameter to run properly then add it to the above code. Could get stuff to work on its own, but never when I tried to combine the two.
For Each trade In Class
If trade.Width = 0 And DivS <> "All" Then
'do nothing
ElseIf trade.Width <> 0 And DivS <> "All" And trade.Value <> ClassS.Value Then
trade.EntireColumn.Hidden = True
End If
Next trade

 

[onlyadrafter]

Hello,

Am I on the right lines here?

Sub DOUBLE_FILTER()
    Application.ScreenUpdating = True
    Columns("I:UD").Hidden = False
    MY_DIVISION = UCase(Range("B2").Value)
    For MY_COLUMNS = 9 To Cells(2, Columns.Count).End(xlToLeft).Column
        If UCase(Cells(2, MY_COLUMNS).Value) <> MY_DIVISION Then
            Columns(MY_COLUMNS).Hidden = True
        End If
    Next MY_COLUMNS
    MY_CLASS = UCase(Range("B4").Value)
    For MY_COLUMNS = 9 To Cells(2, Columns.Count).End(xlToLeft).Column
        For MY_ROWS = 8 To Cells(Rows.Count, MY_COLUMNS).End(xlUp).Row
            a = Len(UCase(Cells(MY_ROWS, MY_COLUMNS).Value))
            b = Len(Replace(UCase(Cells(MY_ROWS, MY_COLUMNS).Value), MY_CLASS, ""))
            If Len(UCase(Cells(MY_ROWS, MY_COLUMNS).Value)) <> Len(Replace(UCase(Cells(MY_ROWS, MY_COLUMNS).Value), MY_CLASS, "")) Then
                GoTo cont
            End If
        Next MY_ROWS
        Columns(MY_COLUMNS).Hidden = True
cont:
    Next MY_COLUMNS
    Application.ScreenUpdating = False
End Sub