is it possible using the following range (A1:E4) with the header row (A1:E1) to design VBA code that would display specific columns based on a header value like a horizontal auto filter?
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
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
' 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
End Sub
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
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
' 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
End Sub