Is there any better way (faster mainly or neater) to get the values of a
filtered range into an array than copying that filtered range to a different
sheet and then getting the pasted values into an array?
Currently I use this code, but I have a feeling there must be better way,
avoiding the copy:

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

Dim shNew As Worksheet
Dim lRowCount As Long
Dim lColCount As Long
Dim arr

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

lColCount = rngFilter.Columns.Count
lRowCount = rngFilter.SpecialCells(xlCellTypeVisible).Cells.Co unt \
lColCount

For Each shNew In ActiveWorkbook.Worksheets
If shNew.Name = "ZYQYZ" Then
shNew.Delete
End If
Next shNew

Set shNew = ActiveWorkbook.Sheets.Add
shNew.Name = "ZYQYZ"

rngFilter.Copy Sheets("ZYQYZ").Cells(1)

With Sheets("ZYQYZ")
If bHeader Then
arr = .Range(.Cells(2, 1), .Cells(lRowCount, lColCount))
Else
arr = .Range(.Cells(1), .Cells(lRowCount, lColCount))
End If
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With

Application.ScreenUpdating = True

getFilteredRows = arr

End Function


One way would be just looping through the filtered range and only put values
in the array
of rows that are not hidden, but that is a lot slower than the above code.


RBS

This is a bit better than the posted code as we don't need to name the new
sheet:

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

Dim shNew As Worksheet
Dim lRowCount As Long
Dim lColCount As Long
Dim arr

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

lColCount = rngFilter.Columns.Count
lRowCount = rngFilter.SpecialCells(xlCellTypeVisible).Cells.Co unt \
lColCount

Set shNew = ActiveWorkbook.Sheets.Add

rngFilter.Copy shNew.Cells(1)

With shNew
If bHeader Then
arr = .Range(.Cells(2, 1), .Cells(lRowCount, lColCount))
Else
arr = .Range(.Cells(1), .Cells(lRowCount, lColCount))
End If
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With

Application.ScreenUpdating = True

getFilteredRows = arr

End Function


RBS


"RB Smissaert" wrote in message
...
Is there any better way (faster mainly or neater) to get the values of a
filtered range into an array than copying that filtered range to a
different sheet and then getting the pasted values into an array?
Currently I use this code, but I have a feeling there must be better way,
avoiding the copy:

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

Dim shNew As Worksheet
Dim lRowCount As Long
Dim lColCount As Long
Dim arr

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

lColCount = rngFilter.Columns.Count
lRowCount = rngFilter.SpecialCells(xlCellTypeVisible).Cells.Co unt \
lColCount

For Each shNew In ActiveWorkbook.Worksheets
If shNew.Name = "ZYQYZ" Then
shNew.Delete
End If
Next shNew

Set shNew = ActiveWorkbook.Sheets.Add
shNew.Name = "ZYQYZ"

rngFilter.Copy Sheets("ZYQYZ").Cells(1)

With Sheets("ZYQYZ")
If bHeader Then
arr = .Range(.Cells(2, 1), .Cells(lRowCount, lColCount))
Else
arr = .Range(.Cells(1), .Cells(lRowCount, lColCount))
End If
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With

Application.ScreenUpdating = True

getFilteredRows = arr

End Function


One way would be just looping through the filtered range and only put
values in the array
of rows that are not hidden, but that is a lot slower than the above code.


RBS

Code could be tidied up a bit mo

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

Dim shNew As Worksheet
Dim lRowCount As Long
Dim lColCount As Long

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

lColCount = rngFilter.Columns.Count
lRowCount = rngFilter.SpecialCells(xlCellTypeVisible).Cells.Co unt \
lColCount

Set shNew = ActiveWorkbook.Sheets.Add

rngFilter.Copy shNew.Cells(1)

With shNew
If bHeader Then
getFilteredRows = .Range(.Cells(2, 1), .Cells(lRowCount, lColCount))
Else
getFilteredRows = .Range(.Cells(1), .Cells(lRowCount, lColCount))
End If
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With

Application.ScreenUpdating = True

End Function


RBS


"RB Smissaert" wrote in message
...
This is a bit better than the posted code as we don't need to name the new
sheet:

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

Dim shNew As Worksheet
Dim lRowCount As Long
Dim lColCount As Long
Dim arr

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

lColCount = rngFilter.Columns.Count
lRowCount = rngFilter.SpecialCells(xlCellTypeVisible).Cells.Co unt \
lColCount

Set shNew = ActiveWorkbook.Sheets.Add

rngFilter.Copy shNew.Cells(1)

With shNew
If bHeader Then
arr = .Range(.Cells(2, 1), .Cells(lRowCount, lColCount))
Else
arr = .Range(.Cells(1), .Cells(lRowCount, lColCount))
End If
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With

Application.ScreenUpdating = True

getFilteredRows = arr

End Function


RBS


"RB Smissaert" wrote in message
...
Is there any better way (faster mainly or neater) to get the values of a
filtered range into an array than copying that filtered range to a
different sheet and then getting the pasted values into an array?
Currently I use this code, but I have a feeling there must be better way,
avoiding the copy:

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

Dim shNew As Worksheet
Dim lRowCount As Long
Dim lColCount As Long
Dim arr

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

lColCount = rngFilter.Columns.Count
lRowCount = rngFilter.SpecialCells(xlCellTypeVisible).Cells.Co unt \
lColCount

For Each shNew In ActiveWorkbook.Worksheets
If shNew.Name = "ZYQYZ" Then
shNew.Delete
End If
Next shNew

Set shNew = ActiveWorkbook.Sheets.Add
shNew.Name = "ZYQYZ"

rngFilter.Copy Sheets("ZYQYZ").Cells(1)

With Sheets("ZYQYZ")
If bHeader Then
arr = .Range(.Cells(2, 1), .Cells(lRowCount, lColCount))
Else
arr = .Range(.Cells(1), .Cells(lRowCount, lColCount))
End If
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With

Application.ScreenUpdating = True

getFilteredRows = arr

End Function


One way would be just looping through the filtered range and only put
values in the array
of rows that are not hidden, but that is a lot slower than the above
code.


RBS

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


"RB Smissaert" wrote in message
...
Code could be tidied up a bit mo

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

Dim shNew As Worksheet
Dim lRowCount As Long
Dim lColCount As Long

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

lColCount = rngFilter.Columns.Count
lRowCount = rngFilter.SpecialCells(xlCellTypeVisible).Cells.Co unt \
lColCount

Set shNew = ActiveWorkbook.Sheets.Add

rngFilter.Copy shNew.Cells(1)

With shNew
If bHeader Then
getFilteredRows = .Range(.Cells(2, 1), .Cells(lRowCount, lColCount))
Else
getFilteredRows = .Range(.Cells(1), .Cells(lRowCount, lColCount))
End If
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With

Application.ScreenUpdating = True

End Function


RBS


"RB Smissaert" wrote in message
...
This is a bit better than the posted code as we don't need to name the
new sheet:

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

Dim shNew As Worksheet
Dim lRowCount As Long
Dim lColCount As Long
Dim arr

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

lColCount = rngFilter.Columns.Count
lRowCount = rngFilter.SpecialCells(xlCellTypeVisible).Cells.Co unt \
lColCount

Set shNew = ActiveWorkbook.Sheets.Add

rngFilter.Copy shNew.Cells(1)

With shNew
If bHeader Then
arr = .Range(.Cells(2, 1), .Cells(lRowCount, lColCount))
Else
arr = .Range(.Cells(1), .Cells(lRowCount, lColCount))
End If
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With

Application.ScreenUpdating = True

getFilteredRows = arr

End Function


RBS


"RB Smissaert" wrote in message
...
Is there any better way (faster mainly or neater) to get the values of a
filtered range into an array than copying that filtered range to a
different sheet and then getting the pasted values into an array?
Currently I use this code, but I have a feeling there must be better
way, avoiding the copy:

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

Dim shNew As Worksheet
Dim lRowCount As Long
Dim lColCount As Long
Dim arr

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

lColCount = rngFilter.Columns.Count
lRowCount = rngFilter.SpecialCells(xlCellTypeVisible).Cells.Co unt \
lColCount

For Each shNew In ActiveWorkbook.Worksheets
If shNew.Name = "ZYQYZ" Then
shNew.Delete
End If
Next shNew

Set shNew = ActiveWorkbook.Sheets.Add
shNew.Name = "ZYQYZ"

rngFilter.Copy Sheets("ZYQYZ").Cells(1)

With Sheets("ZYQYZ")
If bHeader Then
arr = .Range(.Cells(2, 1), .Cells(lRowCount, lColCount))
Else
arr = .Range(.Cells(1), .Cells(lRowCount, lColCount))
End If
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With

Application.ScreenUpdating = True

getFilteredRows = arr

End Function


One way would be just looping through the filtered range and only put
values in the array
of rows that are not hidden, but that is a lot slower than the above
code.


RBS

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

Hi Jim,

As you say, interesting, but not usable.
Peculiar that there is no better way to get the filtered
data other than copying to another sheet.

RBS


"Jim Cone" wrote in message
...
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