Get filtered range into array

[RB Smissaert]

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.Count \
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

[RB Smissaert]

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.Count \
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" <bart.sm...@gmail.com> wrote in message
news:i45n7g$i9b$1...@news.eternal-september.org...

[RB Smissaert]

Code could be tidied up a bit more:

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.Count \
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" <bart.sm...@gmail.com> wrote in message

news:i45o5c$pj4$1...@news.eternal-september.org...

[RB Smissaert]

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" <bart.sm...@gmail.com> wrote in message

news:i45ohn$sge$1...@news.eternal-september.org...

[Jim Cone]

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).SpecialCells(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" <bart.sm...@gmail.com>
wrote in message

news:i48n94$b5i$1...@news.eternal-september.org...

[RB Smissaert]

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" <james....@comcast.netXXX> wrote in message
news:i4a5h3$iu8$1...@speranza.aioe.org...

[Dave Peterson]

One could loop through the visible rows of the original filtered data and just
add the values to an array.

This may be better (depending on the definition of better <vbg>).

--
Dave Peterson

[RB Smissaert]

Haven't tested that, but I guess that will be a lot slower.

RBS

"Dave Peterson" <pete...@XSPAMverizon.net> wrote in message
news:i4b766$232$2...@news.eternal-september.org...

[Dave Peterson]

I would think it would depend on the results of a filter. If the number of
visible rows is small (whatever that means), I bet it's much faster.

--
Dave Peterson

[Peter T]

Hi Bart,

Think I agree with Dave, with a small range it would be faster.

OTH, you'd save some time if you use a permanent dummy sheet in an addin,
rather than creating/deleting a sheet each time.

Regards,
Peter T

"RB Smissaert" <bart.sm...@gmail.com> wrote in message

news:i4b7uj$cln$1...@news.eternal-september.org...

[RB Smissaert]

OK, will test the 2 methods and see how they compare.

RBS

"Peter T" <pet...@discussions.com> wrote in message
news:i4bea4$ja8$1...@news.eternal-september.org...

[RB Smissaert]

OK, had a look at looping throug the range, looking for non-hidden rows and
putting that
in an array and indeed with a small number of rows that is faster than
pasting and copying the range.
When about half the rows are hidden (and with a range one column wide) the
cut-off point is about 2500
rows. So above that the method with paste and copy is faster.
Keeping the same sheet rather than adding and deleting a sheet doesn't
really make much difference.

Function getFilteredRows2(rngFilter As Range, _
Optional bOmitHeader As Boolean) As Variant

Dim r As Long
Dim n As Long
Dim c As Long
Dim x As Long
Dim lFirstRow As Long
Dim arr() As Variant
Dim lRows As Long
Dim lColumns As Long

lRows = rngFilter.Rows.Count
lColumns = rngFilter.Columns.Count

If bOmitHeader Then
lFirstRow = 2
Else
lFirstRow = 1
End If

'count non-hidden rows
'---------------------
For r = lFirstRow To lRows
If rngFilter.Cells(r, 1).EntireRow.Hidden = False Then
n = n + 1
End If
Next r

'size the final array
'--------------------
ReDim arr(1 To n, 1 To lColumns) As Variant

'get the data of the non-hidden rows
'-----------------------------------
If lColumns = 1 Then
For r = lFirstRow To lRows
If rngFilter.Cells(r, 1).EntireRow.Hidden = False Then
x = x + 1
arr(x, 1) = rngFilter.Cells(r, 1)
End If
Next r
Else
For r = lFirstRow To lRows
If rngFilter.Cells(r, 1).EntireRow.Hidden = False Then
x = x + 1
For c = 1 To lColumns
arr(x, c) = rngFilter.Cells(r, c)
Next c
End If
Next r
End If

getFilteredRows2 = arr

End Function

RBS

"RB Smissaert" <bart.sm...@gmail.com> wrote in message

news:i4beqb$dv0$1...@news.eternal-september.org...

[Peter T]

A few simple changes seem to speed things up considerably. In particular
only read each hidden property once, also read entire individual rows to an
array, then copy that to the main array. Anything to reduce reading
individual cells!

Function getFilteredRows3(rngFilter As Range, _

Optional bOmitHeader As Boolean) As Variant

Dim r As Long
Dim n As Long
Dim c As Long
Dim x As Long
Dim lFirstRow As Long
Dim arr() As Variant
Dim lRows As Long
Dim lColumns As Long

lRows = rngFilter.Rows.Count
lColumns = rngFilter.Columns.Count

If bOmitHeader Then
lFirstRow = 2
Else
lFirstRow = 1
End If

'count non-hidden rows
'---------------------
ReDim bArrVis(lFirstRow To lRows) As Boolean

For r = lFirstRow To lRows
If rngFilter.Cells(r, 1).EntireRow.Hidden = False Then
n = n + 1

bArrVis(r) = True
End If
Next r

'size the final array
'--------------------
ReDim arr(1 To n, 1 To lColumns) As Variant

'get the data of the non-hidden rows
'-----------------------------------
If lColumns = 1 Then
For r = lFirstRow To lRows
'If rngFilter.Cells(r, 1).EntireRow.Hidden = False Then

If bArrVis(r) Then

x = x + 1
arr(x, 1) = rngFilter.Cells(r, 1)
End If
Next r
Else

ReDim arrRow(1 To rngFilter.Columns.Count)

For r = lFirstRow To lRows
'If rngFilter.Cells(r, 1).EntireRow.Hidden = False Then

If bArrVis(r) Then

x = x + 1

arrRow = rngFilter.Rows(r).Cells.Value

For c = 1 To lColumns
' arr(x, c) = rngFilter.Cells(r, c)

arr(x, c) = arrRow(1, c)

Next c
End If
Next r
End If

getFilteredRows3 = arr

End Function

Of course the proportion of filtered/hidden rows and number of columns would
be factors either way.

Regards,
Peter T

PS only very lightly tested!

"RB Smissaert" <bart.sm...@gmail.com> wrote in message

news:i4c0d8$6oq$1...@news.eternal-september.org...

[RB Smissaert]

Had a look at reading the hidden property only once
and storing in an array, but didn't see much difference,
but will test again. Didn't look though at putting rows
in an array and looping through that row array rather than
the range and will try that.

RBS

"Peter T" <pet...@discussions.com> wrote in message

news:i4c3gn$flt$1...@news.eternal-september.org...

[RB Smissaert]

Remember now why I didn't try putting row range
in an array and reading that row array. In my particular
situation the range is nearly always one column wide,
so in that case I thought there will be no gain.

RBS

"RB Smissaert" <bart.sm...@gmail.com> wrote in message

news:i4c3sa$9bk$1...@news.eternal-september.org...

[RB Smissaert]

Done some testing and fastest is to store the hidden row property in a
boolean array
and also to read the whole range (not row by row) in an array:

Function getFilteredRows4(rngFilter As Range, _

Optional bOmitHeader As Boolean) As Variant

Dim r As Long
Dim n As Long
Dim c As Long
Dim x As Long
Dim lFirstRow As Long

Dim arrRange() As Variant
Dim arr() As Variant
Dim arrVisibleRows() As Boolean

Dim lRows As Long
Dim lColumns As Long

lRows = rngFilter.Rows.Count
lColumns = rngFilter.Columns.Count

If bOmitHeader Then
lFirstRow = 2
Else
lFirstRow = 1
End If

'put the range in an array
'-------------------------
arrRange = rngFilter

'setup a boolean array to store non-hidden rows
'----------------------------------------------
ReDim arrVisibleRows(lFirstRow To lRows)

'count non-hidden rows and store in Boolean array
'------------------------------------------------

For r = lFirstRow To lRows
If rngFilter.Cells(r, 1).EntireRow.Hidden = False Then
n = n + 1

arrVisibleRows(r) = True
End If
Next r

'size the final array
'--------------------
ReDim arr(1 To n, 1 To lColumns) As Variant

'get the data of the non-hidden rows
'-----------------------------------
If lColumns = 1 Then
For r = lFirstRow To lRows

If arrVisibleRows(r) Then

x = x + 1

arr(x, 1) = arrRange(r, 1)

End If
Next r
Else
For r = lFirstRow To lRows

If arrVisibleRows(r) Then

x = x + 1
For c = 1 To lColumns

arr(x, c) = arrRange(r, c)

Next c
End If
Next r
End If

getFilteredRows4 = arr

End Function

Can't see much scope now to make this faster.

RBS

"Peter T" <pet...@discussions.com> wrote in message

news:i4c3gn$flt$1...@news.eternal-september.org...

[Dave Peterson]

You can loop through the visible rows of the filtered range without looking at
each row to see its "hiddenness":

Option Explicit
Sub testme()

Dim VisRng As Range
Dim wks As Worksheet
Dim myArr As Variant
Dim rCtr As Long
Dim cCtr As Long
Dim myCell As Range

Set wks = Worksheets("Sheet1")

With wks
With .AutoFilter.Range
With .Columns(1)
If .Cells.SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then
MsgBox "only headers visible"
Exit Sub 'do nothing
End If

Set VisRng = .Resize(.Rows.Count - 1).Offset(1, 0) _
.Cells.SpecialCells(xlCellTypeVisible)
End With

ReDim myArr(1 To VisRng.Cells.Count, 1 To .Columns.Count)

rCtr = 0
For Each myCell In VisRng.Cells
rCtr = rCtr + 1
For cCtr = 1 To .Columns.Count
myArr(rCtr, cCtr) = myCell.Offset(0, cCtr - 1).Value
Next cCtr
Next myCell
End With
End With
End Sub

I didn't do any comparison to see what is faster.

--
Dave Peterson

[Peter T]

The boolean array is exactly what I did. However I also found it faster to
read individual rows to an array, assuming of course the range is more than
one column wide.

FWIW I found the example I posted between 2 to 4 times faster depending on
the test range.

Regards,
Peter T

"RB Smissaert" <bart.sm...@gmail.com> wrote in message

news:i4c5f2$q2e$1...@news.eternal-september.org...

[Peter T]

Hi Dave,

FWIW I find SpecialCells can be extremely slow if trying to create a large
multi-area range.

Regards,
Peter T

"Dave Peterson" <pete...@XSPAMverizon.net> wrote in message

news:i4c691$2m3$1...@news.eternal-september.org...

[RB Smissaert]

> read individual rows to an array

Bit faster though to read just the whole range into an array.
Never found something 4 times faster, but that may have to do with the data
we are looking at.

RBS

"Peter T" <pet...@discussions.com> wrote in message

news:i4c89h$5dm$1...@news.eternal-september.org...

[Dave Peterson]

I've never noticed a problem. But I've never looked for one, either -- or done
any speed tests.

--
Dave Peterson