How do I Unhide columns that are equal to a Drop Down/Cell Value?

[dancran]

Hello everyone,

I am pretty new to this whole Excel VBA, Macro business. I have a relatively large spreadsheet (couple hundred columns) and I am trying to make it easier to navigate / select what I am viewing. I am using Excel 2007 if that is important.

This spreadsheet keeps track of contract information with a customer. Every once and a while the information changes. When this occurs the new information is dubbed Change 1,2,3,etc. In my spreadsheet the "Change #" is entered in Row 6 with the new information underneath of it. What I want my VBA code/Macro to do is only show the columns that equal the text selected from a Drop Down (in cell B5) menu created using Data Validation of Row 6. So if the Drop Down selection equals a value in Row 6, I want to keep that column visible, but other columns not visible. If the Drop Down selection is blank or """" then hide nothing.

The part where it gets trickier, is that each Change requires two column entries. So when I want to show the information for one change based on the Drop Down selection, I actually want that Column PLUS the Column to the right of it.

If I need to clarify/re-word anything please let me know. I am experienced with programming, just not in VBA so I am not sure how to setup what I want to do. Any help would be appreciated!

Dan

  <table border="0" cellpadding="0" cellspacing="0" width="1216"><col style="width:48pt" span="19" width="64">  <tbody><tr style="height:15.0pt" height="20">   <td style="height:15.0pt;width:48pt" height="20" width="64">Change 1</td>   <td style="width:48pt" width="64">
</td>   <td style="width:48pt" width="64">
</td>   <td style="width:48pt" width="64">
</td>   <td style="width:48pt" width="64">
</td>   <td style="width:48pt" width="64">
</td>   <td style="width:48pt" width="64">
</td>   <td style="width:48pt" width="64">
</td>   <td style="width:48pt" width="64">
</td>   <td style="width:48pt" width="64">
</td>   <td style="width:48pt" width="64">
</td>   <td style="width:48pt" width="64">
</td>   <td style="width:48pt" width="64">
</td>   <td style="width:48pt" width="64">
</td>   <td style="width:48pt" width="64">
</td>   <td style="width:48pt" width="64">
</td>   <td style="width:48pt" width="64">
</td>   <td style="width:48pt" width="64">
</td>   <td style="width:48pt" width="64">
</td>  </tr>  <tr style="height:15.0pt" height="20">   <td style="height:15.0pt" height="20">
</td>   <td>
</td>   <td>
</td>   <td>
</td>   <td>
</td>   <td>
</td>   <td>
</td>   <td>
</td>   <td>
</td>   <td>
</td>   <td>
</td>   <td>
</td>   <td>
</td>   <td>
</td>   <td>
</td>   <td>
</td>   <td>
</td>   <td>
</td>   <td>
</td>  </tr>  <tr style="height:15.0pt" height="20">   <td style="height:15.0pt" height="20">
</td>   <td>
</td>   <td>Change 1</td>   <td>
</td>   <td>Change 2</td>   <td>
</td>   <td>Change 3</td>   <td>
</td>   <td> Change 4</td>   <td>
</td>   <td>Total</td>   <td>Change 1</td>   <td>
</td>   <td> Change 2</td>   <td>
</td>   <td>Change 3</td>   <td>
</td>   <td>Change 4</td>   <td>
</td>  </tr>  <tr style="height:15.0pt" height="20">   <td style="height:15.0pt" align="right" height="20">1</td>   <td>
</td>   <td>a</td>   <td>a</td>   <td>a</td>   <td>a</td>   <td>a</td>   <td>a</td>   <td>a</td>   <td>a</td>   <td>4a</td>   <td>a</td>   <td>a</td>   <td>a</td>   <td>a</td>   <td>a</td>   <td>a</td>   <td>a</td>   <td>a</td>  </tr>  <tr style="height:15.0pt" height="20">   <td style="height:15.0pt" align="right" height="20">2</td>   <td>
</td>   <td>b</td>   <td>b</td>   <td>b</td>   <td>b</td>   <td>b</td>   <td>b</td>   <td>b</td>   <td>b</td>   <td>4b</td>   <td>b</td>   <td>b</td>   <td>b</td>   <td>b</td>   <td>b</td>   <td>b</td>   <td>b</td>   <td>b</td>  </tr>  <tr style="height:15.0pt" height="20">   <td style="height:15.0pt" align="right" height="20">3</td>   <td>
</td>   <td>c</td>   <td>c</td>   <td>c</td>   <td>c</td>   <td>c</td>   <td>c</td>   <td>c</td>   <td>c</td>   <td>4c</td>   <td>c</td>   <td>c</td>   <td>c</td>   <td>c</td>   <td>c</td>   <td>c</td>   <td>c</td>   <td>c</td>  </tr>  <tr style="height:15.0pt" height="20">   <td style="height:15.0pt" align="right" height="20">4</td>   <td>
</td>   <td>d</td>   <td>d</td>   <td>d</td>   <td>d</td>   <td>d</td>   <td>d</td>   <td>d</td>   <td>d</td>   <td>4d</td>   <td>d</td>   <td>d</td>   <td>d</td>   <td>d</td>   <td>d</td>   <td>d</td>   <td>d</td>   <td>d</td>  </tr> </tbody></table>

 

[dancran]

No, but I did just edit your second version and it is working smoothly now.

Final code I am using is:

Private Sub Worksheet_Change(ByVal Target As Range)
    'If the cell changing is B5
    If Target.Address = "$B$5" Then
        FilterVal = Range("B5").Text
        'Turn off the flicker that's about to happen
        Application.ScreenUpdating = False
        
        'Loop Columns C to End
        For ColIdx = 6 To UsedRange.Columns.Count
            'If the Filter is for Total, then increment every column and hide non-Total
            'Filter something other than Total
                
            'Look for the Column Label of row 6 to match filter
            If Cells(6, ColIdx) = FilterVal Then
                'If matched, then unhide it
                Columns(ColIdx).Hidden = False
                'increment the column index
                ColIdx = ColIdx + 1
                'Unhide that one too
                Columns(ColIdx).Hidden = False
            Else 'not the column label we're looking for
                'Hide 'em
                Columns(ColIdx).Hidden = True
                Columns(ColIdx + 1).Hidden = True
            End If
        Next
        'Turn the flicker back on
        Application.ScreenUpdating = True
    End If
End Sub

I have one additional question though. Is there a way to remove duplicates from a drop down when making it from Data Validation? I.E. Not have an option to select a blank for each blank cell in a row? It would make the "searcher" if you will appear much cleaner than just entering the value you are looking for in Row 6.


I appreciate the help, this definitely would have been over my head. I understand how it works, I just wouldn't have been able to come up with it on my own.

Dan

 

[tweedle]

I had to change one thing to make it work for my spreadsheet ( 3 to a 6 in my for statement) and it is almost running smoothly.

Done

I decided to remove the drop down for the time being (doesn't change anything though) and just enter the values to search for manually.

Maybe, Maybe not - needs to be exact match (incl spaces) based on assumption that validation was used

The problems that are showing up are:

If I have everything displayed (unhidden) and type in a Change #, it will return nothing. Then if I go back and type a different Change #, it will return those results correctly.

would ask to verify the first test now knowing the exactness needed.

Next, if the correct columns are displaying for a certain Change # and I remove the text to make it blank/null, it will only return the totals I have throughout the spreadsheet, rather than every column.

Code written based on the validation and that items selected would be filtered.

Enter blank -> Returns all totals and changes correctly

Revision to allow "all" or "" which will show all columns

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$B$5" Then
        FilterVal = Range("B5").Text
        Application.ScreenUpdating = False
 
[COLOR=blue]        If Trim(FilterVal) = "" Or LCase(FilterVal) = "all" Then[/COLOR]
[COLOR=blue]            For ColIdx = UsedRange.Columns.Count To 6 Step -1[/COLOR]
[COLOR=blue]                Columns(ColIdx).Hidden = False[/COLOR]
[COLOR=blue]            Next[/COLOR]
[COLOR=blue]        Else[/COLOR]
 
        For ColIdx = UsedRange.Columns.Count To 6 Step -2
            If Cells(6, ColIdx) = FilterVal Then
                Columns(ColIdx).Hidden = False
                Columns(ColIdx + 1).Hidden = False
            Else
                Columns(ColIdx).Hidden = True
                Columns(ColIdx + 1).Hidden = True
            End If
        Next
        [COLOR=blue]End If[/COLOR]
        Application.ScreenUpdating = True
    End If
End Sub

 

[tweedle]

I have one additional question though. Is there a way to remove duplicates from a drop down when making it from Data Validation? I.E. Not have an option to select a blank for each blank cell in a row? It would make the "searcher" if you will appear much cleaner than just entering the value you are looking for in Row 6.

Not directly; would need to make a unique list elsewhere and use that for the source for the data validation list.

I appreciate the help, this definitely would have been over my head. I understand how it works, I just wouldn't have been able to come up with it on my own.

Been there!

 

[dancran]

Not directly; would need to make a unique list elsewhere and use that for the source for the data validation list.

Lame... You would think that the word Data Validation would allow you to remove duplicates. Oh well, as you say, if I really wanted to I could made a secure drop down by creating my own unique list that checks for doubles. As for now I will call it a day. Thanks for the help! This will definitely make it easier to move forward and verify the information in this spreadsheet.

Dan

 

[tweedle]

Unique List Generator

Sub GenUniqueList()
'---------------------------------------------------------------------------------------
' Procedure : GenUniqueList
' Author    : tweedle
' Citation  : [URL]http://www.mrexcel.com/forum/showthread.php?t=570216[/URL]
' Adapted By:
' Date      : Mon 2011-08-08
' Purpose   : Outputs a unique list from selected cells
'---------------------------------------------------------------------------------------
'
    Dim rngSrc, rngTarget
    Dim Cell As Range
    Dim arr()
    On Error Resume Next
    Set rngSrc = Application.InputBox("Select the Range of cells", Type:=8)
    Set rngTarget = Application.InputBox("Where to put the list?", Type:=8)
    If rngSrc Is Nothing Or rngTarget Is Nothing Then
        MsgBox "Can't process without selections."
        Exit Sub
    End If
    ReDim arr(1)
    For Each Cell In rngSrc
        NotIn = True
        For arrIdx = LBound(arr) To UBound(arr)
            If Cell = arr(arrIdx) Then
                NotIn = False
            End If
        Next arrIdx
        If NotIn Then
            ReDim Preserve arr(UBound(arr) + 1)
            arr(UBound(arr)) = Cell
        End If
    Next
    rngTarget.Cells(1, 1).Activate
    RowIdx = 1
    For arrIdx = LBound(arr) To UBound(arr)
        If Not IsEmpty(arr(arrIdx)) Then
            rngTarget.Cells(RowIdx, 1) = arr(arrIdx)
            RowIdx = RowIdx + 1
        End If
    Next arrIdx
End Sub