|
Get filtered range into array
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 |
Get filtered range into array
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 |
Get filtered range into array
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 |
Get filtered range into array
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 |
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 |
Get filtered range into array
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 |
Get filtered range into array
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 |
Get filtered range into array
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 |
Get filtered range into array
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. On 08/16/2010 06:36, RB Smissaert wrote: 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 |
Get filtered range into array
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 |
Get filtered range into array
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 |
Get filtered range into array
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 |
Get filtered range into array
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 |
Get filtered range into array
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" 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 |
Get filtered range into array
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" wrote in message ... 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" 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 |
Get filtered range into array
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 |
Get filtered range into array
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 |
Get filtered range into array
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" wrote in message ... 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 |
Get filtered range into array
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 |
Get filtered range into array
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" wrote in message ... 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" wrote in message ... 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 |
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 |
| All times are GMT +1. The time now is 12:21 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com