LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #19   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 420
Default Get filtered range into array

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

On 08/16/2010 16:02, Peter T wrote:
Hi Dave,

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

Regards,
Peter T

"Dave Peterson" wrote in message
...
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.

On 08/16/2010 15:00, RB Smissaert wrote:
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" wrote in message
...
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" wrote in message
...
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" wrote in message
...
OK, will test the 2 methods and see how they compare.

RBS


"Peter T" wrote in message
...
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" wrote in message
...
Haven't tested that, but I guess that will be a lot slower.

RBS


"Dave Peterson" wrote in message
...
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).

On 08/16/2010 02:58, RB Smissaert wrote:
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





--
Dave Peterson







--
Dave Peterson



--
Dave Peterson
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Dim an array from a filtered Range CBartman Excel Programming 1 October 16th 09 06:48 PM
Redimming an array dynamically assigned from range (how to redim first dimension of a 2-D array? /or/ reverse the original array order) Keith R[_2_] Excel Programming 3 November 13th 07 04:08 PM
Array copying to a filtered region Jason Yang Excel Programming 8 February 22nd 07 01:09 PM
Filtered Array for Listbox Jim at Eagle Excel Programming 4 June 14th 06 04:37 PM
traversing through a filtered range based on another filtered range zestpt[_4_] Excel Programming 4 July 12th 04 06:37 PM


All times are GMT +1. The time now is 09:38 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"