Automatically display filter range in report header in Excel

K

Kjetil

I often use filters to create various reports in analysis from larger
querytables, but it's quite timeconsuming to change headers, titles and such,
to secure the right understanding of the content of a printed report. Having
an option to define this in the Header/Footer section would have been very
helpful and efficient, I believe.

----------------
This post is a suggestion for Microsoft, and Microsoft responds to the
suggestions with the most votes. To vote for this suggestion, click the "I
Agree" button in the message pane. If you do not see the button, follow this
link to open the suggestion in the Microsoft Web-based Newsreader and then
click "I Agree" in the message pane.

http://www.microsoft.com/office/com...dg=microsoft.public.excel.worksheet.functions
 
G

Gary L Brown

Here's a macro that I adjusted for your needs. It puts the filter
information into the left footer. I called it 'Filters_Footer'.
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''Yes'' button next to ''Was this
Post Helpfull to you?''.

'/===========================================/
Sub Filters_Footer()
'put filters applied to database into footer
Dim filterArray()
Dim f As Long
Dim i As Long
Dim xCounter As Long
Dim currentFiltRange As String, strAnswer As String
Dim strAnswerTitle As String
Dim varPrinters As Variant
Dim strAndIf As String
Dim w As Worksheet

'check for an active workbook
If ActiveWorkbook Is Nothing Then 'no workbooks open, so create one
Workbooks.Add
End If

xCounter = 0
Set w = ActiveSheet
strAnswer = ""

'check if autofilter is on
If w.AutoFilterMode = False Then
strAnswer = "No Filter"
End If

If Len(strAnswer) = 0 Then
strAnswerTitle = "Filters in Worksheet..."
With w.AutoFilter
currentFiltRange = .Range.Address
i = .Range.Column - 1

strAnswer = "Worksheet/Range: " & w.Name & _
"!" & currentFiltRange & vbCr
With .Filters
ReDim filterArray(1 To .Count, 1 To 3)
For f = 1 To .Count
With .Item(f)
If .On Then
xCounter = 1
filterArray(f, 1) = .Criteria1
strAnswer = strAnswer & _
WorksheetFunction.Rept(" ", 31) & _
"Col: ( " & _
ColumnLetterFromNumber(f + i) & " ) " _
& .Criteria1
If .Operator Then
filterArray(f, 2) = .Operator
filterArray(f, 3) = .Criteria2

If .Operator = xlAnd Then
strAndIf = " and "
Else
strAndIf = " or "
End If

strAnswer = _
strAnswer & strAndIf & .Criteria2

End If
strAnswer = strAnswer & vbCr
End If
End With
Next f
End With
End With

If xCounter = 0 Then
strAnswer = "No Filter"
End If
End If

ActiveSheet.PageSetup.LeftFooter = strAnswer

exit_Sub:
Set w = Nothing

End Sub
'/===========================================/
Private Function ColumnLetterFromNumber(iColNumber As Long) _
As String
'this function converts column number into letters
'this is designed to only work thru YYYYYZ
' 308,915,776 columns - should be enough :O>
'Gary Brown 10/12/2005
Dim blnZ As Boolean
Dim dblNumber As Double
Dim i As Integer, iLettersInColumns As Integer
Dim strCol As String

Application.Volatile True

iLettersInColumns = 6 ' 26^6 = 308,915,776
blnZ = False

On Error GoTo err_Function

dblNumber = iColNumber

If dblNumber > 26 ^ iLettersInColumns Then GoTo err_Function

If dblNumber = 26 Then blnZ = True

iLettersInColumns = iLettersInColumns - 1

For i = iLettersInColumns To 0 Step -1
If (dblNumber / (26 ^ i)) >= 1 Then
If blnZ = False Then
strCol = _
strCol & Chr(Int(dblNumber / (26.00001 ^ i)) + 64)
Else
strCol = strCol & "Z"
Exit For
End If
dblNumber = _
dblNumber - (Int(dblNumber / (26.00001 ^ i)) * (26 ^ i))
End If
Next i

ColumnLetterFromNumber = strCol

exit_Function:
Exit Function

err_Function:
ColumnLetterFromNumber = ""
GoTo exit_Function
End Function
'/===========================================/
 
K

Kjetil

Thanks a lot, I'll test it out to see if I can make it work. Macros in Excel
is not my strongest side, but it looks quite like other programming languages
I work with. However, I believe a lot of Excel-users would be happy, if they
in a future version of Excel could just push a "Filter-info" button in the
report setup dialog, together with page-info, tabs, files, catalogs, do you
agree?
 
K

Kjetil

It worked great, thanks a lot!

Kjetil

Gary L Brown said:
Here's a macro that I adjusted for your needs. It puts the filter
information into the left footer. I called it 'Filters_Footer'.
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''Yes'' button next to ''Was this
Post Helpfull to you?''.

'/===========================================/
Sub Filters_Footer()
'put filters applied to database into footer
Dim filterArray()
Dim f As Long
Dim i As Long
Dim xCounter As Long
Dim currentFiltRange As String, strAnswer As String
Dim strAnswerTitle As String
Dim varPrinters As Variant
Dim strAndIf As String
Dim w As Worksheet

'check for an active workbook
If ActiveWorkbook Is Nothing Then 'no workbooks open, so create one
Workbooks.Add
End If

xCounter = 0
Set w = ActiveSheet
strAnswer = ""

'check if autofilter is on
If w.AutoFilterMode = False Then
strAnswer = "No Filter"
End If

If Len(strAnswer) = 0 Then
strAnswerTitle = "Filters in Worksheet..."
With w.AutoFilter
currentFiltRange = .Range.Address
i = .Range.Column - 1

strAnswer = "Worksheet/Range: " & w.Name & _
"!" & currentFiltRange & vbCr
With .Filters
ReDim filterArray(1 To .Count, 1 To 3)
For f = 1 To .Count
With .Item(f)
If .On Then
xCounter = 1
filterArray(f, 1) = .Criteria1
strAnswer = strAnswer & _
WorksheetFunction.Rept(" ", 31) & _
"Col: ( " & _
ColumnLetterFromNumber(f + i) & " ) " _
& .Criteria1
If .Operator Then
filterArray(f, 2) = .Operator
filterArray(f, 3) = .Criteria2

If .Operator = xlAnd Then
strAndIf = " and "
Else
strAndIf = " or "
End If

strAnswer = _
strAnswer & strAndIf & .Criteria2

End If
strAnswer = strAnswer & vbCr
End If
End With
Next f
End With
End With

If xCounter = 0 Then
strAnswer = "No Filter"
End If
End If

ActiveSheet.PageSetup.LeftFooter = strAnswer

exit_Sub:
Set w = Nothing

End Sub
'/===========================================/
Private Function ColumnLetterFromNumber(iColNumber As Long) _
As String
'this function converts column number into letters
'this is designed to only work thru YYYYYZ
' 308,915,776 columns - should be enough :O>
'Gary Brown 10/12/2005
Dim blnZ As Boolean
Dim dblNumber As Double
Dim i As Integer, iLettersInColumns As Integer
Dim strCol As String

Application.Volatile True

iLettersInColumns = 6 ' 26^6 = 308,915,776
blnZ = False

On Error GoTo err_Function

dblNumber = iColNumber

If dblNumber > 26 ^ iLettersInColumns Then GoTo err_Function

If dblNumber = 26 Then blnZ = True

iLettersInColumns = iLettersInColumns - 1

For i = iLettersInColumns To 0 Step -1
If (dblNumber / (26 ^ i)) >= 1 Then
If blnZ = False Then
strCol = _
strCol & Chr(Int(dblNumber / (26.00001 ^ i)) + 64)
Else
strCol = strCol & "Z"
Exit For
End If
dblNumber = _
dblNumber - (Int(dblNumber / (26.00001 ^ i)) * (26 ^ i))
End If
Next i

ColumnLetterFromNumber = strCol

exit_Function:
Exit Function

err_Function:
ColumnLetterFromNumber = ""
GoTo exit_Function
End Function
'/===========================================/
Click to expand...
 
Top