How do I dynamically hide fields based on an auto filter selection?

Referencing the attached spreadsheet, when a users filters on column B (Class) I want to hide the columns the are not applicable. Applicable columns are listed on Map sheet by class, X = display and blank = hide.

An alternative would be to hid columns with no data. This should work with a multi-select filter as well.

I don't know much about VBA in excel, so please try to keep it simple.

Thanks,
Mike
C--Users-mhwy-Desktop-Sampler1.xlsx
mmcrainAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

[ fanpages ]IT Services ConsultantCommented:
Just to clarify your requirements...

[Map] worksheet contents:

[Map] worksheet
[Data] worksheet contents:

Q_28712893 - Data

If "Pump" is selected in column [ B ] of the [Data] worksheet then you only wish to see...

columns [ B ], [C], [D], [E], & [G] within the [Data] worksheet.

However, if "Tank" is selected instead, you wish to remove column [D] ("Model"), & add column [ I ] ("Capacity") from those shown on the [Data] worksheet.

Is that correct?
mmcrainAuthor Commented:
Fanpages, you have the concept right. For everything we would include A & B. So for "Pump" we would show [A],[ B ],[C],[D],[E],[G].

For "Tank" we would hide [D] and show [ I ]

The real spreadsheet that I can't share has 102 columns and a couple hundred rows.
[ fanpages ]IT Services ConsultantCommented:
OK, thanks.

Ah... if it has 102 columns, does that mean that the [Map] worksheet stretches out to 102 (103) columns as well?

What may help visualise this (for you, me, or any following contributor) is if you set the [Map] & [Data] worksheets to be in-line with each other; that is, column [ B ] in [Map] is column [ B ] in [Data].

Is that possible/practical, does your [Map] worksheet need to be offset by one column from the same presentation in [Data]?
CompTIA Security+

Learn the essential functions of CompTIA Security+, which establishes the core knowledge required of any cybersecurity role and leads professionals into intermediate-level cybersecurity jobs.

mmcrainAuthor Commented:
yep, 102 would be on the [Map] worksheet.

Making the columns line up would not be a problem. Attachment updated.
C--Users-mhwy-Desktop-Sampler1-Revi.xlsx
[ fanpages ]IT Services ConsultantCommented:
Thanks again.

What should happen if multiple values are selected for Filtering within column [ B ] of the [Data] worksheet?

Should only the first "Class" shown (row 1 to the last row) dictate the visibility of the subsequent columns, or should a collection of "Class" values mean all applicable columns are shown (regardless of their suitability for a sub-set of the "Class" values selected)?
mmcrainAuthor Commented:
Good question! Ideally all applicable columns for all the selected class fields should be displayed.
[ fanpages ]IT Services ConsultantCommented:
Hi!

No... thank you for this entire question.

I enjoy problems that are not run-of-the-mill queries.

I have attached a workbook, based on your most recent submission to this thread, that contains a new worksheet, [Hidden].

This is intended to have a Visible setting of "Hidden" or "Very Hidden", although the code I have provided will continue to function as intended if the worksheet remains visible.

Further notes on what I have implemented are included within the code listing below (taken from the attached workbook).

Option Explicit
' -------------------------------------------------------------------------------------------------------------------------------
' The [Hidden] worksheet is intended to have a Visible setting of "Hidden" (0) or "Very Hidden" (2).
' It will, however, continue to function as intended if set to "Visible" (-1).
'
' When the Workbook is opened, the ThisWorkbook.Workbook_Open() event code sets the Visible property to xlSheetVeryHidden (2).
'
' Cell [A1] of this worksheet contains the formula: =SUBTOTAL(103,Data!B:B)
' This calculates the number of visible cells within column [B] of the [Data] worksheet.
'
' Application.Calculation is set to xlCalculationAutomatic (-4105) within the ThisWorkbook.Workbook_Open() event code.
'
' Changing the AutoFilter settings of column [B] within the [Data] worksheet, invokes a Calculation of the Workbook.
' The Calculation prompts a change to the formula in cell [A1], that then runs the Worksheet_Calculate() event code.
'
' The Worksheet_Calculate() event code ultimately changes the Visible setting of individual columns of the [Data] worksheet.
' The visibility of each applicable column for the (one, or many) "Class" values selected are defined within the [Map] worksheet.
'
' Columns [A] & [B] of the [Data] worksheet remain Visible regardless of the settings within the [Map] worksheet.
' -------------------------------------------------------------------------------------------------------------------------------

Private lngErr_Number                                   As Long
Private strErr_Description                              As String
Private Sub Worksheet_Calculate()

' -------------------------------------------------------------------------------------------------------------------------------
' [ http://www.experts-exchange.com/questions/28712893/How-do-I-dynamically-hide-fields-based-on-an-auto-filter-selection.html ]
'
' Question Channel: Experts Exchange > Questions > How do I dynamically hide fields based on an auto filter selection?
' Topic Area:       [ http://www.experts-exchange.com/topics/ms-excel/ ]
'
' ID:               Q_28712893
' Question Title:   How do I dynamically hide fields based on an auto filter selection?
' Question Dated:   2015-09-10 07:35 PM
' Question Asker:   mmcrain
' Asker Profile:    [ http://www.experts-exchange.com/members/mmcrain.html ]
'
' Solution posted:  11 September 2015 by fanpages
' Expert Profile:   [ http://www.experts-exchange.com/members/fanpages.html ] | [ http://www.experts-exchange.com/M_258171.html ]
' -------------------------------------------------------------------------------------------------------------------------------
' Copyright:        (c) 2015 Clearlogic Concepts (UK) Limited                                            [ http://NigelLee.info ]
'
' Licensed for use by Experts Exchange members under Experts Exchange Terms-of-Use, provided the copyright statement is retained.
' -------------------------------------------------------------------------------------------------------------------------------

  Dim blnContinue                                       As Boolean
  Dim blnErr_Ignore                                     As Boolean
  Dim blnVisible()                                      As Boolean
  Dim lngLoop                                           As Long
  Dim objCell                                           As Range
  Dim objRange                                          As Range
  Dim objScripting_Dictionary                           As Object
  Dim objWorksheet_Data                                 As Worksheet
  Dim objWorksheet_Map                                  As Worksheet
  Dim vntKey                                            As Variant
  
  On Error GoTo Err_Worksheet_Calculate
  
  Application.ScreenUpdating = False
  
  Erase blnVisible()
  ReDim blnVisible(0&) As Boolean
  
  Set objRange = Nothing
  Set objWorksheet_Data = ThisWorkbook.Worksheets("Data")
  Set objWorksheet_Map = ThisWorkbook.Worksheets("Map")
  Set objScripting_Dictionary = CreateObject("Scripting.Dictionary")
  Set vntKey = Nothing
  
  blnContinue = Not (objScripting_Dictionary Is Nothing)
  
  If (blnContinue) Then
     objScripting_Dictionary.RemoveAll
  
     lngErr_Number = 0&
     Err.Clear
  
     blnErr_Ignore = True
     Set objRange = objWorksheet_Data.Range(objWorksheet_Data.Cells(1&), objWorksheet_Data.Cells.SpecialCells(xlCellTypeLastCell))
     blnErr_Ignore = False
     
     blnContinue = ((lngErr_Number = 0&) And Not (objRange Is Nothing))
  End If ' If (blnContinue) Then
  
  If (blnContinue) Then
     lngErr_Number = 0&
     Err.Clear
     
     blnErr_Ignore = True
     Set objRange = Intersect(objRange, objWorksheet_Data.Columns("B").SpecialCells(xlCellTypeVisible))
     blnErr_Ignore = False
     
     blnContinue = ((lngErr_Number = 0&) And Not (objRange Is Nothing))
  End If ' If (blnContinue) Then
  
  If (blnContinue) Then
     Set objCell = objWorksheet_Data.Cells(1&, "B").End(xlDown)
     
     For Each objCell In objRange
         DoEvents
         
         If objCell.Row > 1& Then
            If Not (objScripting_Dictionary.Exists(objCell.Value)) Then
               objScripting_Dictionary.Add objCell.Value, objCell.Row
            End If ' If Not (objScripting_Dictionary(objCell.Row)) Then
         End If ' If objCell.Row > 1& Then
         
     Next objCell ' For Each objCell In objIntersect
     
     blnContinue = (objScripting_Dictionary.Count > 0&)
  End If ' If (blnContinue) Then

  If (blnContinue) Then
     blnContinue = (objWorksheet_Map.Cells.SpecialCells(xlCellTypeLastCell).Column > 2)
  End If ' If (blnContinue) Then
  
  If (blnContinue) Then
     ReDim blnVisible(objWorksheet_Map.Cells.SpecialCells(xlCellTypeLastCell).Column) As Boolean
     
     blnVisible(1&) = True
     blnVisible(2&) = True
     
     For Each vntKey In objScripting_Dictionary.Keys
     
         DoEvents
         
         Set objCell = Nothing
         
         lngErr_Number = 0&
         Err.Clear
     
         blnErr_Ignore = True
         Set objCell = objWorksheet_Map.Columns(2).Find(What:=CStr(vntKey))
         blnErr_Ignore = False
         
         blnContinue = ((lngErr_Number = 0&) And Not (objCell Is Nothing))
         
         If (blnContinue) Then
            Set objRange = Nothing
            
            lngErr_Number = 0&
            Err.Clear
     
            blnErr_Ignore = True
            Set objRange = objWorksheet_Map.Range(objWorksheet_Map.Cells(objCell.Row, "C"), objWorksheet_Map.Cells(objCell.Row, objWorksheet_Map.Columns.Count).End(xlToLeft))
            blnErr_Ignore = False
                                                  
            blnContinue = ((lngErr_Number = 0&) And Not (objRange Is Nothing))
         End If ' If (blnContinue) Then
         
         If (blnContinue) Then
            lngErr_Number = 0&
            Err.Clear
            
            blnErr_Ignore = True
            Set objRange = objRange.SpecialCells(xlCellTypeConstants)
            blnErr_Ignore = False
            
            blnContinue = ((lngErr_Number = 0&) And Not (objRange Is Nothing))
         End If ' If (blnContinue) Then
         
         If (blnContinue) Then
            If objRange.Column > 2 Then
               For Each objCell In objRange
                   
                   DoEvents
                   
                   If objCell.Column <= UBound(blnVisible) Then
                      blnVisible(objCell.Column) = True
                   End If ' If objCell.Column <= UBound(blnVisible) Then
                   
               Next objCell ' For Each objCell In objRange
            End If ' If objRange.Column > 2 Then
         End If ' If (blnContinue) Then
         
     Next vntKey ' For Each vntKey In objScripting_Dictionary.Keys
     
     For lngLoop = 1& To UBound(blnVisible)
         objWorksheet_Data.Columns(lngLoop).EntireColumn.Hidden = Not (blnVisible(lngLoop))
     Next lngLoop ' For lngLoop = 1& To UBound(blnVisible)
  End If ' If (blnContinue) Then
  
Exit_Worksheet_Calculate:

  On Error Resume Next
  
  If Not (objScripting_Dictionary Is Nothing) Then
     objScripting_Dictionary.RemoveAll
     Set objScripting_Dictionary = Nothing
  End If ' If Not (objScripting_Dictionary Is Nothing) Then
  
  Set vntKey = Nothing
  Set objWorksheet_Map = Nothing
  Set objWorksheet_Data = Nothing
  Set objRange = Nothing
  
  Erase blnVisible()
  ReDim blnVisible(0&) As Boolean
  
  Application.ScreenUpdating = True
  
  Exit Sub
  
Err_Worksheet_Calculate:

  lngErr_Number = Err.Number
  strErr_Description = Err.Description
  
  On Error Resume Next
  
  If (blnErr_Ignore) Then
     On Error GoTo Err_Worksheet_Calculate
     Resume Next
  End If ' If (blnErr_Ignore) Then
  
  Application.ScreenUpdating = True
  
  Beep
  MsgBox "Error #" & CStr(lngErr_Number) & _
         vbCrLf & vbLf & _
         strErr_Description, _
         vbExclamation Or vbOKOnly, _
         ThisWorkbook.Name
         
  Resume Exit_Worksheet_Calculate
  
End Sub

Open in new window



Please let me know if this meets your requirements.

Thank you.
Q_2812893.xlsm

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
mmcrainAuthor Commented:
Outstanding! This is working perfectly!!!
Thank you very much,
Mike
[ fanpages ]IT Services ConsultantCommented:
You are very welcome.

It kept me from watching 'trash TV' for a couple of hours, so that was a bonus! :)
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.