Getting the Range Address of an AutoFiltered Range

Anonymous

I have a worksheet with the following column labels beginning in cell A3:

A3 = Year

B3 = Product ID

C3 = Jan Unpublished Estimate

D3 = Jan Published Estimate

E3 = Feb Unpublished Estimate

F3 = Feb Published Estimate

I have enabled filtering on the range A3:F200. I then filter on Year (2011), and Product ID (203135). This results in rows 6 through 97 being displayed, although the row numbers are not consecutive (i.e., not all the rows between 6 and 97 meet the filter criteria).

Is there a way to programmatically get the range address (specifically, the top and bottom rows) of the displayed range?

Thanks in advance for any assistance.

Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.

0 comments

Answer accepted by question author

Anonymous

First off, I have no problem if you use Andreas's code instead of mine (he obviously has had more experience with filtering than I have and his code seems to be fully debugged)... it never bothers me when someone else's code is selected for use over the code I submit. Actually, I do this coding more for myself than for the person who asked the question... that they may be able to make use of it is a plus. I have always enjoyed doing puzzles and a good amount of questions that get asked in forums (and newsgroups) provide me with a ready supply of interesting puzzles to solve (this thread being one of them... which is one of the reasons I am doggedly attempting to "get it right").

As for the incorrect result you pointed out for the top filtered row... that was more a result of my not understanding what should get returned when the filter hid all of its filtered items. Initially, I figured the first visible row after the filter would be what was wanted. I guessed wrong on that.<g> Here are my functions fixed to account for the filter hiding all of its items...

Function GetFilteredRangeTopRow() As Long

Dim HeaderRow As Long, LastFilterRow As Long

On Error GoTo NoFilterOnSheet

With ActiveSheet

HeaderRow = .AutoFilter.Range(1).Row

LastFilterRow = .Range(Split(.AutoFilter.Range.Address, ":")(1)).Row

GetFilteredRangeTopRow = .Range(.Rows(HeaderRow + 1), .Rows(Rows.Count)). _

SpecialCells(xlCellTypeVisible)(1).Row

If GetFilteredRangeTopRow = LastFilterRow + 1 Then GetFilteredRangeTopRow = 0

End With

NoFilterOnSheet:

End Function

Function GetFilteredRangeBottomRow() As Long

Dim HeaderRow As Long, LastFilterRow As Long

On Error GoTo NoFilterOnSheet

With ActiveSheet

HeaderRow = .AutoFilter.Range(1).Row

LastFilterRow = .Range(Split(.AutoFilter.Range.Offset(1).Address, ":")(1)).Row

GetFilteredRangeBottomRow = .Range(.Rows(HeaderRow + 1), .Rows(LastFilterRow + 1)). _

Find(What:="*", After:=.Rows(LastFilterRow + 1).Cells(1), _

SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row

If GetFilteredRangeBottomRow = LastFilterRow + 1 Then GetFilteredRangeBottomRow = 0

End With

NoFilterOnSheet:

End Function

0 comments

Answer accepted by question author

Andreas Killer 144.1K Volunteer Moderator

Please study this:

Option Explicit

Sub Main()

Dim Data(1 To 10, 1 To 2)

Dim i As Long

Dim Msg As String

Dim Bug As Integer

For i = 1 To UBound(Data)

Data(i, 1) = i Mod 2

Data(i, 2) = 1

For i = 1 To 5

Cells.Clear

With Range("C5")

.Value = "Nr"

.Offset(-2, 0) = "Something"

.Offset(1, 0).Resize(UBound(Data), UBound(Data, 2)) = Data

.Offset(UBound(Data) + 2, 0) = "Something"

Select Case i

Case 1

.CurrentRegion.AutoFilter 1, "=0"

Case 2

.CurrentRegion.AutoFilter 1, "=1"

Case 3

.CurrentRegion.AutoFilter 2, "<>1"

Case 4

.CurrentRegion.AutoFilter 2, "=1"

Case 5

'No Filter

End Select

End With

MsgBox AutoFilterTopRow & " - " & AutoFilterBottomRow

End Sub

Function AutoFilterTopRow() As Long

'Attention! Works only with small ranges!!!

Dim WS As Worksheet, R As Range

Set WS = ActiveSheet

'Return 0 if not filter is set

If Not WS.AutoFilterMode Then Exit Function

'Get the whole range from the filter

Set R = WS.AutoFilter.Range

'Remove headings

Set R = R.Offset(1, 0).Resize(R.Rows.Count - 1, R.Columns.Count)

'Get the visible cells if any

On Error GoTo ExitPoint

Set R = R.SpecialCells(xlCellTypeVisible)

'Return the row of first cell

AutoFilterTopRow = R.Row

ExitPoint:

End Function

Function AutoFilterBottomRow() As Long

'Attention! Works only with small ranges!!!

Dim WS As Worksheet, R As Range, A As Range

Set WS = ActiveSheet

'Return 0 if not filter is set

If Not WS.AutoFilterMode Then Exit Function

'Get the whole range from the filter

Set R = WS.AutoFilter.Range

'Remove headings

Set R = R.Offset(1, 0).Resize(R.Rows.Count - 1, R.Columns.Count)

'Get the visible cells if any

On Error GoTo ExitPoint

Set R = R.SpecialCells(xlCellTypeVisible)

'Get the last area

Set A = R.Areas(R.Areas.Count)

'Return the row of last cell in this area

AutoFilterBottomRow = A(A.Count).Row

ExitPoint:

End Function

0 comments

46 additional answers

Anonymous

2011-06-10T18:44:18+00:00

I'm a little confused as to how the range you requested would be of much help to you as it would include all hidden cells between the first and last cell. However, if that is what you want...

Sub GetFullRange()

Dim Rng As Range, RWs() As String

RWs = Split(ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Address(0, 0), ":")

Set Rng = Intersect(Columns("A"), Range(Split(RWs(1), ",")(1) & ":" & RWs(UBound(RWs))))

MsgBox Rng.Address

End Sub

Perhaps this would be more useful though...

Sub GetVisibleRange()

Dim Rng As Range

Set Rng = Intersect(Columns("A"), ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible))

MsgBox Rng.Address(0, 0)

End Sub
Was this answer helpful?

0 comments No comments
Anonymous

2011-06-10T17:59:56+00:00

Andreas,

Thanks for your help. I really appreciate it. However, what I was really looking for is some code that would return the first row and last row of the displayed (i.e., filtered) range. Using my original example, I would like the code to return a range as in Range(Cells(6,1),Cells(97,1)) or simply Range("A6:A97").

Sorry, I should have been more specific in my request.
Was this answer helpful?

0 comments No comments
Andreas Killer 144.1K Reputation points Volunteer Moderator

2011-06-10T17:21:04+00:00

Sure, run the macro below and look into the immediate window.

Andreas.

Option Explicit

Sub Test()

Dim R As Range, C As Range

Set R = GetAutoFilterRange

If R Is Nothing Then

    Debug.Print "No filter is set or all rows are hidden"

Else

    For Each C In Intersect(R, Columns(1))

      Debug.Print C.Row

    Next

End If

End Sub

Function GetAutoFilterRange( _

    Optional WithoutHeader As Boolean = True, _

    Optional ByVal WS As Worksheet = Nothing) As Range

'Returns the visible range of an autofilter

Dim R As Range, Temp(), i As Long

If WS Is Nothing Then Set WS = ActiveSheet

'No filter, return nothing

If Not WS.AutoFilterMode Then Exit Function

'Get the whole range from the filter

Set R = WS.AutoFilter.Range

'Remove headings?

If WithoutHeader Then _

    Set R = R.Offset(1, 0).Resize(R.Rows.Count - 1, R.Columns.Count)

'Is the filter activ?

If WS.FilterMode Then

    'SpecialCells-BUG is fixed in XL2010

    If Val(Application.Version) < 14 Then

      'Split the whole range in handy parts (SpecialCells can not handle large ranges!)

      Temp = SplitRange(R)

      'Error's off, we get an error if no cells are visible

      On Error Resume Next

      'Get the visible cells in each part

      For i = 0 To UBound(Temp)

        Set Temp(i) = Temp(i).SpecialCells(xlCellTypeVisible)

        'If an error occurs all cells are hidden

        If Err.Number <> 0 Then

          Set Temp(i) = Nothing

          Err.Clear

        End If

      Next

      On Error GoTo 0

      'Combine the parts to a range

      For i = 1 To UBound(Temp)

        If Not Temp(i) Is Nothing Then

          If Temp(0) Is Nothing Then

            Set Temp(0) = Temp(i)

          Else

            Set Temp(0) = Union(Temp(0), Temp(i))

          End If

        End If

      Next

      Set R = Temp(0)

    Else

      'Error's off, we get an error if no cells are visible

      On Error Resume Next

      Set R = R.SpecialCells(xlCellTypeVisible)

      If Err.Number <> 0 Then

        Err.Clear

        Set R = Nothing

      End If

    End If

End If

'Return the result

Set GetAutoFilterRange = R

End Function

Private Function SplitRange(R As Range, Optional ByVal MaxRows As Long = 16384) As Variant

'Split a large range into an array of ranges (useful for SpecialCells and other complex ranges)

Dim Dict As Object 'Dictionary

Dim i As Long, j As Long

Dim Area As Range

Set Dict = CreateObject("Scripting.Dictionary")

For Each Area In R.Areas

    j = 0

    For i = 1 To Area.Rows.Count Step MaxRows

      j = j + MaxRows

      If j > Area.Rows.Count Then j = Area.Rows.Count

      Dict.Add Dict.Count, Range(Area(i, 1), Area(j, Area.Columns.Count))

    Next

Next

SplitRange = Dict.Items

End Function
Was this answer helpful?

0 comments No comments