I adapted this macro from J.Walk to hide selected rows. It displays a
dialog box listing all available columns, and hides the ones that are
checked.
Public Sub SelectColumnsToHide()
Dim i As Integer, iColumnNumber As Integer
Dim TopPos As Integer, LeftPos As Integer
Dim ColumnCount As Integer
Dim PrintDlg As DialogSheet
Dim cb As CheckBox
Dim rngSheet As Excel.Range
Dim rngHeader As Excel.Range
Dim wshSheet As Excel.Worksheet
Dim strHeader As String
Dim maxTopPos As Integer
Dim dialogColumns As Integer
Const topPosShift As Integer = 13
Const leftPosShift As Integer = 150
Const initialTopPos As Integer = 40
Const initialLeftPos As Integer = 78
Const rowsPerDialogColumn As Integer = 30
On Error Resume Next
Set wshSheet = Application.ActiveSheet
If wshSheet Is Nothing Then
Call MsgBox("You must perform this action on a sheet that
actually has columns.", _
vbOKOnly + vbInformation, "Well DUH!")
Exit Sub
End If
Set rngHeader = Application.InputBox("Select a cell in the header
row", "Looking for the headers", , , , , , 8)
On Error GoTo 0
If rngHeader Is Nothing Then Exit Sub
Set rngHeader = rngHeader.EntireRow.Cells(1, 1)
Application.ScreenUpdating = False
' Check for protected workbook
If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical + vbOKOnly, "Can't
do this"
Exit Sub
End If
' Add a temporary dialog sheet
Set wshSheet = ActiveSheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add
ColumnCount = 0
' Add the checkboxes
dialogColumns = 1
maxTopPos = 0
TopPos = initialTopPos
LeftPos = initialLeftPos
For i = 1 To wshSheet.UsedRange.Columns.Count
strHeader = rngHeader.Offset(0, i - 1)
If Len(strHeader) > 0 Then
ColumnCount = ColumnCount + 1
PrintDlg.CheckBoxes.Add LeftPos, TopPos, 150, 16.5
PrintDlg.CheckBoxes(ColumnCount).Text = i & " - " &
strHeader
TopPos = TopPos + topPosShift
If (TopPos >= initialTopPos + rowsPerDialogColumn *
topPosShift) Then
dialogColumns = dialogColumns + 1
maxTopPos = TopPos
TopPos = initialTopPos
LeftPos = LeftPos + leftPosShift
End If
End If
Next i
If (maxTopPos = 0) Then
maxTopPos = TopPos
End If
' Move the OK and Cancel buttons
PrintDlg.Buttons.Left = 140 + dialogColumns * leftPosShift
' Set dialog height, width, and caption
With PrintDlg.DialogFrame
.Height = Application.Max(68, PrintDlg.DialogFrame.Top +
maxTopPos - 34)
.Width = 130 + dialogColumns * leftPosShift
.Caption = "Select columns to hide"
End With
' Change tab order of OK and Cancel buttons
' so the 1st option button will have the focus
With PrintDlg
.Buttons("Button 2").BringToFront
.Buttons("Button 3").BringToFront
' Display the dialog box
If ColumnCount <> 0 Then
If .Show Then
For i = 1 To .CheckBoxes.Count
If .CheckBoxes(i).Value = xlOn Then
' extract column number
iColumnNumber = Left(.CheckBoxes(i).Caption,
InStr(1, .CheckBoxes(i).Caption, " "))
wshSheet.Cells(1,
iColumnNumber).EntireColumn.ColumnWidth = 0
End If
Next i
End If
Else
Call MsgBox("Sheet must have a row with headers for this
to work.", vbOKOnly + vbInformation)
End If
End With
' Delete temporary dialog sheet (without a warning)
Application.DisplayAlerts = False
PrintDlg.Delete
Application.DisplayAlerts = True
' Reactivate original sheet
Application.ScreenUpdating = True
End Sub
