View Single Post
  #8   Report Post  
Posted to microsoft.public.excel.misc
iliace iliace is offline
external usenet poster
 
Posts: 229
Default Horizontal filtering

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



On Oct 24, 9:02 am, wrote:
On Oct 24, 2:19 am, "Roger Govier" <rogerattechnology4NOSPAMu.co.uk
wrote:





Hi


Take a look at Debra Dalgleish's site.
Debra has created a sample workbook which will hide certain columns,
dependent upon criteria that you enter in a cell. This will give you a good
start to achieve what you want.
The file can be downloaded athttp://www.contextures.com/HideMarkedCols.zip


--
Regards
Roger Govier


wrote in message


roups.com...


I can not figure out how to auto-filter columns to display just the
way auto-filter dynamically filters what rows to display. The only
option I can think of is GROUPING, but that is a far cry from being an
optimal solution. Any suggestions would be appreciated.- Hide quoted text -


- Show quoted text -


I'll give this a look. Thanks.- Hide quoted text -

- Show quoted text -