View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.worksheet.functions
Kjetil Kjetil is offline
external usenet poster
 
Posts: 7
Default Automatically display filter range in report header in Excel

It worked great, thanks a lot!

Kjetil

"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
'/===========================================/