View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Jim Cone[_2_] Jim Cone[_2_] is offline
external usenet poster
 
Posts: 1,549
Default Get filtered range into array

Not a real solution, but it was an interesting exercise...
'--
Sub TestIt()
Dim vFilterRange As Variant
Dim strFilterAddress As String
Dim x As Long
Dim y As Long

'The range address has a length limitation of ~ 256 characters.
'So the following only works on a small filtered range.
'You must specify the filtered column number.

strFilterAddress = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCel ls(xlCellTypeVisible).Address
vFilterRange = VBA.Split(strFilterAddress, ",", -1, vbBinaryCompare)

x = LBound(vFilterRange, 1)
y = UBound(vFilterRange, 1)
MsgBox "Lower bound is: " & x & vbCr & "Upper bound is: " & y

vFilterRange = VBA.Join(vFilterRange, ":")
vFilterRange = VBA.Split(vFilterRange, ":", -1, vbBinaryCompare)

x = LBound(vFilterRange, 1)
y = UBound(vFilterRange, 1)
MsgBox "Lower bound is: " & x & vbCr & "Upper bound is: " & y
End Sub

--
Jim Cone
Portland, Oregon USA
http://www.mediafire.com/PrimitiveSoftware

..
..
..

"RB Smissaert"
wrote in message
...
Just some further streamlining of this code.
Still not found a better way to handle this.

Function getFilteredRows(rngFilter As Range, _
Optional bOmitHeader As Boolean, _
Optional oSheet As Worksheet) As Variant

Dim shNew As Worksheet

If oSheet Is Nothing Then
Set oSheet = ActiveSheet
End If

If oSheet.FilterMode = False Then
'early exit if the sheet has no active filter
'--------------------------------------------
getFilteredRows = rngFilter
Exit Function
End If

Application.ScreenUpdating = False

Set shNew = ActiveWorkbook.Sheets.Add

rngFilter.Copy shNew.Cells(1)

With shNew
If bOmitHeader Then
getFilteredRows = .Range(.Cells(2, 1), .Cells(2, 1).SpecialCells(xlLastCell))
Else
getFilteredRows = .UsedRange
End If

Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
Application.ScreenUpdating = True
End Function

RBS