VBA to display specific columns based on a header in a range...

[sadams1]

How much of a stretch would it be to take the following range (A1:E4) with the header row (A1:E1) & have code that would display specific columns based on a header value? For instance, "show only the column with 'Banana' in the header" or "show only columns with 'Apple' and 'Banana' in the header row".

I have the following but it only selects the columns & doesn't hide the others.

Sub FindAddressColumn()
Dim xRg As Range
Dim xRgUni As Range
Dim xFirstAddress As String
Dim xStr As String
On Error Resume Next
xStr = "Name"
Set xRg = Range("A1:P1").Find(xStr, , xlValues, xlWhole, , , True)
If Not xRg Is Nothing Then
xFirstAddress = xRg.Address
Do
Set xRg = Range("A1:P1").FindNext(xRg)
If xRgUni Is Nothing Then
Set xRgUni = xRg
Else
Set xRgUni = Application.Union(xRgUni, xRg)
End If
Loop While (Not xRg Is Nothing) And (xRg.Address <> xFirstAddress)
End If
xRgUni.EntireColumn.Select
End Sub

 

[mumps]

Would it work for you if you simply double clicked on any cell in a column to hide that column? If not you would need a way to specify which columns you want to show.

 

[sadams1]

The actual range goes all they way to the "OL" column & 20,000th row so it's much larger & manually hiding large numbers of columns to isolate & display only a few isn't time efficient which is why the code I have is close but wanted to see if there's another approach would be simplier.

It's the reverse of what I have to delete columns in a range based on values in a header row...


Sub MyDeleteColumns()

Dim lc As Long, c As Long

Application.ScreenUpdating = False

' Find last column in title row with heading
lc = Cells(1, Columns.Count).End(xlToLeft).Column

' Loop through all columns, backwards, up to column C
For c = lc To 1 Step -1
' Check to see if there is no data in the column
If Cells(1, c).End(xlDown).Row = Rows.Count Then
' Exclude certain titles
If (Cells(1, c) <> "Banana") And (Cells(1, c) <> "Apple") Then
' Delete column
Columns(c).Delete
End If
End If
Next c

Application.ScreenUpdating = True

End Sub

 

[mumps]

The problem with your approach is that you would have to change the headers in the code every time you wanted to display different columns. One approach that would work would be to have a list of all column headers in another sheet, let's say in column A. Then in column B you could put an "x" beside each header in column A that you would want to remain visible. In this manner all you would have to do is add and/or delete the x's and then run the macro. If the number of columns that you want to keep visible is always small, then they can be hard coded in the macro and changed when necessary. But this would be tedious if the number of columns was large. Your thoughts?

 

[sadams1]

The problem with your approach is that you would have to change the headers in the code every time you wanted to display different columns.
Yes & it would like an "auto filter"


One approach that would work would be to have a list of all column headers in another sheet, let's say in column A. Then in column B you could put an "x" beside each header in column A that you would want to remain visible. In this manner all you would have to do is add and/or delete the x's and then run the macro.

Would like not to have a separate list. Was hoping the code included would show what I have & to see if it could used as template but my coding skills are suspect at best but appreciate the help!

 

[mumps]

Click here to download your file. I have created a userform which allows you to select the headers of the columns you want to show. Run the macro in Module1 to display the userform. The buttons on the userform are self explanatory. The userform will automatically adjust in size depending on the number of column headers in you worksheet. I have used Sheet1 as the default sheet name. Change this sheet name in the code in the attached file to suit your needs. This is the code:

Private Sub CommandButton1_Click()
    Dim ctrl As MSForms.Control, fnd As Range, ws As Worksheet
    Set ws = Sheets("Sheet1")
    For Each ctrl In Me.Controls
        If TypeName(ctrl) = "CheckBox" Then
            Set fnd = ws.Rows(1).Find(ctrl.Caption)
            If ctrl.Value = True Then
                Columns(fnd.Column).Hidden = False
            Else
                Columns(fnd.Column).Hidden = True
            End If
        End If
    Next ctrl
End Sub

Private Sub CommandButton2_Click()
    Dim ctrl As MSForms.Control
    For Each ctrl In Me.Controls
        If TypeName(ctrl) = "CheckBox" Then
            ctrl.Value = False
        End If
    Next ctrl
End Sub

Private Sub CommandButton3_Click()
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, lCol As Long, chkBox As Control, x As Long
    Set ws = Sheets("Sheet1")
    lCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
    For x = 1 To lCol
        Set chkBox = Me.Controls.Add("Forms.CheckBox.1", "CheckBox" & i)
        chkBox.Caption = ws.Cells(1, x)
        chkBox.Left = 5
        chkBox.Top = 5 + ((x - 1) * 20)
    Next x
    Application.ScreenUpdating = True
End Sub

Private Sub UserForm_Activate()
    CheckSize
End Sub

Private Sub CheckSize()
    Dim h, w
    Dim c As Control
    h = 0: w = 0
    For Each c In Me.Controls
        If c.Visible Then
            If c.Top + c.Height > h Then h = c.Top + c.Height
            If c.Left + c.Width > w Then w = c.Left + c.Width
        End If
    Next c
    If h > 0 And w > 0 Then
        With Me
            .Width = w + 40
            .Height = h + 40
        End With
    End If
End Sub

 

[sadams1]

wow...can't thank you enough for going to the trouble of doing this. I'll see if I can figure it out!

 

[mumps]

You are very welcome.

 

[sadams1]

You are very welcome.

OK...I've spent the past few hours trying to get this to work & haven't had much luck. I'm relatively decent hacker with code but not with buttons & boxes yet. Would it be possible to simplify this to where the columns to be shown can be manually entered like the "MyDeleteColumns()" where the columns to delete are manually changed? Sorry to be a pain.

 

[mumps]

Manually entering the column headers would be very tedious and prone to typographical errors. The approach I suggested would be the easiest and safest way to do what you want. Can you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.