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

 

[sadams1]

OK...been chewing on this...2 questions so far
1) can the header row be in row 2 instead of row 1? There's one reference to row 1...I changed that to (2) but it isn't getting picked up
2) the number of column headers makes the userform longer than the screen...I'm unable to scroll down as the form locks the screen.

Otherwise, this is EXACTLY what I'm looking for!

 

[mumps]

Click here to download you file. This uses a list box instead of check boxes. Simply select all the columns you want to remain visible. If the list is long, you can scroll down.
This is the code:

Private Sub CommandButton1_Click()
    Dim i As Long, fnd As Range, ws As Worksheet
    Set ws = Sheets("Sheet1")
    For i = 0 To Me.ListBox1.ListCount - 1
        Set fnd = ws.Rows(2).Find(ListBox1.List(i))
        If ListBox1.Selected(i) = True Then
            ws.Columns(fnd.Column).Hidden = False
        Else
            ws.Columns(fnd.Column).Hidden = True
        End If
    Next i
End Sub

Private Sub CommandButton3_Click()
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, lCol As Long, x As Long
    Set ws = Sheets("Sheet1")
    lCol = ws.Cells(2, Columns.Count).End(xlToLeft).Column
    For x = 1 To lCol
        ListBox1.AddItem ws.Cells(2, x)
    Next x
    Application.ScreenUpdating = True
End Sub

 

[sadams1]

figured I'd just export the userform & import it my spreadsheet...turns out there's already a blank "Userform1" & deleting it seems to be next to impossible. I've gone through this site & others looking for ways to do so & not having much luck. I even messed with a blank macro enabled workbook trying to import the userform & module from your test file & when importing the username form, I get

"Line 8: Property OleObjectBlob in UserForm1 had an invalid file reference."

I'll keep wrestling with this b/c it's AMAZING.

 

[sadams1]

OK...figured out how to get it to work in the actual file. The results were different than expected so I took the your test file & added 410 column headers to see how it behaves without data...in the attached file, I only checked "409" & this is the result....not sure what to think (?)

***can't figure how to upload a file***

 

[sadams1]

created a "box" account...can you get the file from this link?

sadamsx.xlsm | Powered by Box

app.box.com

 

[mumps]

Replace the current macros with the following:

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim i As Long, fnd As Range, ws As Worksheet
    Set ws = Sheets("Sheet1")
    For i = 0 To Me.ListBox1.ListCount - 1
        Set fnd = ws.Rows(2).Find(ListBox1.List(i), LookIn:=xlValues, lookat:=xlWhole)
        If ListBox1.Selected(i) = True Then
            ws.Columns(fnd.Column).Hidden = False
        Else
            ws.Columns(fnd.Column).Hidden = True
        End If
    Next i
    Unload Me
    Application.ScreenUpdating = True
End Sub

Private Sub CommandButton3_Click()
    Unload Me
End Sub

Private Sub CommandButton4_Click()
    Application.ScreenUpdating = False
    Dim i As Long, ws As Worksheet
    Set ws = Sheets("Sheet1")
    For i = 1 To ws.Columns.Count
        ws.Columns(i).Hidden = False
    Next i
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, lCol As Long, x As Long
    Set ws = Sheets("Sheet1")
    lCol = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column
    For x = 1 To lCol
        ListBox1.AddItem ws.Cells(2, x)
    Next x
    Application.ScreenUpdating = True
End Sub

 

[sadams1]

NICE! The test file works perfect. Attached is the actual file stripped of data. It errors out when looking for an "object" (?)

Comp.xlsb | Powered by Box

app.box.com

 

[mumps]

Click here to download your file. I've re-entered the numbers in row 2 to replace the original numbers. The file is extremely large (more the 33 megabytes). If you hold down the CTRL key and press the END key, you will see that the last recognized row in the sheet is row 1048000. I would suggest that you delete all the extra blank rows, any extra blank columns and code modules that you don't need and re-save the file immediately after. Then close it and re-open it. The file size was making Excel freeze up on my computer sometimes. In any event, it seems to be working properly.

 

[mumps]

New Version This version includes the SHOW ALL button.

 

[sadams1]

SWEET! The "show all" is a great addition. OK, so I took your file & just pasted (values only) the headers in the actual file. Running the code errors again complaining about "object not set" or something. I messed with the syntax of thinking special characters like an "underscore" or two words with a space between were causing the error but I can't narrow it to something specific. When the header is a sequential number pattern it works perfect but there's something it doesn't like about headers with letters?
Again, I can't thank you enough for spending any time with this...I didn't think it would be this involved!

sadams (1).xlsb | Powered by Box

app.box.com