Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Dim an array from a filtered Range | Excel Programming | |||
Redimming an array dynamically assigned from range (how to redim first dimension of a 2-D array? /or/ reverse the original array order) | Excel Programming | |||
Array copying to a filtered region | Excel Programming | |||
Filtered Array for Listbox | Excel Programming | |||
traversing through a filtered range based on another filtered range | Excel Programming |