Thread
:
Automatically display filter range in report header in Excel
View Single Post
#
3
Posted to microsoft.public.excel.worksheet.functions
Kjetil
external usenet poster
Posts: 7
Automatically display filter range in report header in Excel
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?
"Gary L Brown" wrote:
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
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
'/===========================================/
Reply With Quote
Kjetil
View Public Profile
Find all posts by Kjetil