Charting Non-Contiguous Data Using Declared Range Variables [duplicate] - excel

Is there some limit to what I can select in a range via VBA? Basically what I found is that if I were to hide an entire row while in a loop, it takes quite a while if there are lots of rows to hide.
ex) - Hide any row that doesn't have a value in column A
For i = 1 to 600
With Range("A" & i)
If .value = vbEmpty then .EntireRow.Hidden = True
End With
Next
The more speedy way of doing that is to make a single range that references each of those rows and then do a single ".entirerow.hidden = true" statement. And yes, I already have application.screenupdating = false set.
The problem I'm encountering is that if the string reference for the range is too long, it just fails.
The following code declares a function which accepts both a standard array of row numbers (in case the array is made before hand), as well as parameter arguments (in case you don't want to declare an array before hand, and the list of rows is small). It then creates a string which is used in the range reference.
Function GetRows(argsArray() As Long, ParamArray args() As Variant) As Range
Dim rngs As String
Dim r
For Each r In argsArray
rngs = rngs & "," & r & ":" & r
Next
For Each r In args
rngs = rngs & "," & r & ":" & r
Next
rngs = Right(rngs, Len(rngs) - 1)
Set GetRows = Range(rngs)
End Function
Function dfdfd()
Dim selList(50) As Long, j As Long
For i = 1 To 100
If i Mod 2 = 1 Then
selList(j) = i
j = j + 1
End If
Next
selList(50) = 101
GetRows(selList).Select
End Function
The 2nd function "dfdfd" is just used to give an example of when it fails. To see when it works, just make a new array with say - 5 items, and try that. It works.
Final (?) update:
Option Explicit
Public Sub test()
Dim i As Integer
Dim t As Long
Dim nRng As Range
t = Timer()
Application.ScreenUpdating = False
Set nRng = [A1]
For i = 1 To 6000
Set nRng = Union(nRng, Range("A" & i))
Next
nRng.RowHeight = 0
'nRng.EntireRow.Hidden = true
Application.ScreenUpdating = True
Debug.Print "Union (RowHeight): " & Timer() - t & " seconds"
'Debug.Print "Union (EntireRow.Hidden): " & Timer() - t & " seconds"
End Sub
Results:
Union (row height: 0.109375 seconds
Union (hidden row): 0.625 seconds

I think the magical function you're looking for here is Union(). It's built into Excel VBA, so look at the help for it. It does just what you'd expect.
Loop through your ranges, but instead of building a string, build up a multi-area Range. Then you can select or set properties on the whole thing at once.
I don't know what (if any) the limit on the number of areas you can build up in a single Range is, but it's bigger than 600. I don't know what (if any) limits there are on selecting or setting properties of a multi-area Range either, but it's probably worth a try.

A faster option might be to use the SpecialCells property to find the blanks then hide the rows:
Sub HideRows()
Dim rng As Range
Set rng = ActiveSheet.Range("A1:A600")
Set rng = rng.SpecialCells(xlCellTypeBlanks)
rng.EntireRow.Hidden = True
End Sub
This will only work on cells within the UsedRange, I think.

A minor speedup can be obtained if you set the RowHeight property to 0.
On my system it goes about twice as fast
(on 6000 iterations about 1.17 seconds versus 2.09 seconds)
You didn't mention what 'quite a while' is, and what version of XL you are using...
Your problem may be in part your row detect code that checks for a row you want to hide(?).
Here's my test code in XL 2003 (comment out one version then the other):
Option Explicit
Public Sub test()
Dim i As Integer
Dim t As Long
t = Timer()
Application.ScreenUpdating = False
For i = 1 To 6000
With Range("A" & i)
'If .Value = vbEmpty Then .EntireRow.Hidden = True
If .Value = vbEmpty Then .RowHeight = 0
End With
Next
Application.ScreenUpdating = True
Debug.Print Timer() - t & " seconds"
End Sub

There is a limit to the string length. I just encountered a similar problem and found that if the String Txt of
Range(Txt)
is larger then 255 characters my VBA throws an Error.eg. the code:
Debug.Print sheet1.Range("R2300,T2300,V2300,R2261,T2261,V2261,R1958,T1958,V1958,R1751,T1751,V1751,R1544,T1544,V1544,R1285,T1285,V1285,R1225,T1225,V1225,R1193,T1193,V1193,R1089,T1089,V1089,R802,T802,V802,R535,T535,V535,R264,T264,V264,R205,T205,V205,R168,T168,V168,R135,T135,V135,R101").Areas.count
throws an error (256 characters in string) whereas the code
Debug.Print sheet1.Range("R230,T2300,V2300,R2261,T2261,V2261,R1958,T1958,V1958,R1751,T1751,V1751,R1544,T1544,V1544,R1285,T1285,V1285,R1225,T1225,V1225,R1193,T1193,V1193,R1089,T1089,V1089,R802,T802,V802,R535,T535,V535,R264,T264,V264,R205,T205,V205,R168,T168,V168,R135,T135,V135,R101").Areas.count
has 255 characters and prints out "46" without Error. The number of Areas is in both cases the same.

Related

Excel VBA - I Have Too Many Cells To Be Considered A Range [duplicate]

Is there some limit to what I can select in a range via VBA? Basically what I found is that if I were to hide an entire row while in a loop, it takes quite a while if there are lots of rows to hide.
ex) - Hide any row that doesn't have a value in column A
For i = 1 to 600
With Range("A" & i)
If .value = vbEmpty then .EntireRow.Hidden = True
End With
Next
The more speedy way of doing that is to make a single range that references each of those rows and then do a single ".entirerow.hidden = true" statement. And yes, I already have application.screenupdating = false set.
The problem I'm encountering is that if the string reference for the range is too long, it just fails.
The following code declares a function which accepts both a standard array of row numbers (in case the array is made before hand), as well as parameter arguments (in case you don't want to declare an array before hand, and the list of rows is small). It then creates a string which is used in the range reference.
Function GetRows(argsArray() As Long, ParamArray args() As Variant) As Range
Dim rngs As String
Dim r
For Each r In argsArray
rngs = rngs & "," & r & ":" & r
Next
For Each r In args
rngs = rngs & "," & r & ":" & r
Next
rngs = Right(rngs, Len(rngs) - 1)
Set GetRows = Range(rngs)
End Function
Function dfdfd()
Dim selList(50) As Long, j As Long
For i = 1 To 100
If i Mod 2 = 1 Then
selList(j) = i
j = j + 1
End If
Next
selList(50) = 101
GetRows(selList).Select
End Function
The 2nd function "dfdfd" is just used to give an example of when it fails. To see when it works, just make a new array with say - 5 items, and try that. It works.
Final (?) update:
Option Explicit
Public Sub test()
Dim i As Integer
Dim t As Long
Dim nRng As Range
t = Timer()
Application.ScreenUpdating = False
Set nRng = [A1]
For i = 1 To 6000
Set nRng = Union(nRng, Range("A" & i))
Next
nRng.RowHeight = 0
'nRng.EntireRow.Hidden = true
Application.ScreenUpdating = True
Debug.Print "Union (RowHeight): " & Timer() - t & " seconds"
'Debug.Print "Union (EntireRow.Hidden): " & Timer() - t & " seconds"
End Sub
Results:
Union (row height: 0.109375 seconds
Union (hidden row): 0.625 seconds
I think the magical function you're looking for here is Union(). It's built into Excel VBA, so look at the help for it. It does just what you'd expect.
Loop through your ranges, but instead of building a string, build up a multi-area Range. Then you can select or set properties on the whole thing at once.
I don't know what (if any) the limit on the number of areas you can build up in a single Range is, but it's bigger than 600. I don't know what (if any) limits there are on selecting or setting properties of a multi-area Range either, but it's probably worth a try.
A faster option might be to use the SpecialCells property to find the blanks then hide the rows:
Sub HideRows()
Dim rng As Range
Set rng = ActiveSheet.Range("A1:A600")
Set rng = rng.SpecialCells(xlCellTypeBlanks)
rng.EntireRow.Hidden = True
End Sub
This will only work on cells within the UsedRange, I think.
A minor speedup can be obtained if you set the RowHeight property to 0.
On my system it goes about twice as fast
(on 6000 iterations about 1.17 seconds versus 2.09 seconds)
You didn't mention what 'quite a while' is, and what version of XL you are using...
Your problem may be in part your row detect code that checks for a row you want to hide(?).
Here's my test code in XL 2003 (comment out one version then the other):
Option Explicit
Public Sub test()
Dim i As Integer
Dim t As Long
t = Timer()
Application.ScreenUpdating = False
For i = 1 To 6000
With Range("A" & i)
'If .Value = vbEmpty Then .EntireRow.Hidden = True
If .Value = vbEmpty Then .RowHeight = 0
End With
Next
Application.ScreenUpdating = True
Debug.Print Timer() - t & " seconds"
End Sub
There is a limit to the string length. I just encountered a similar problem and found that if the String Txt of
Range(Txt)
is larger then 255 characters my VBA throws an Error.eg. the code:
Debug.Print sheet1.Range("R2300,T2300,V2300,R2261,T2261,V2261,R1958,T1958,V1958,R1751,T1751,V1751,R1544,T1544,V1544,R1285,T1285,V1285,R1225,T1225,V1225,R1193,T1193,V1193,R1089,T1089,V1089,R802,T802,V802,R535,T535,V535,R264,T264,V264,R205,T205,V205,R168,T168,V168,R135,T135,V135,R101").Areas.count
throws an error (256 characters in string) whereas the code
Debug.Print sheet1.Range("R230,T2300,V2300,R2261,T2261,V2261,R1958,T1958,V1958,R1751,T1751,V1751,R1544,T1544,V1544,R1285,T1285,V1285,R1225,T1225,V1225,R1193,T1193,V1193,R1089,T1089,V1089,R802,T802,V802,R535,T535,V535,R264,T264,V264,R205,T205,V205,R168,T168,V168,R135,T135,V135,R101").Areas.count
has 255 characters and prints out "46" without Error. The number of Areas is in both cases the same.

Application defined or object-defined error ('1004') [duplicate]

Is there some limit to what I can select in a range via VBA? Basically what I found is that if I were to hide an entire row while in a loop, it takes quite a while if there are lots of rows to hide.
ex) - Hide any row that doesn't have a value in column A
For i = 1 to 600
With Range("A" & i)
If .value = vbEmpty then .EntireRow.Hidden = True
End With
Next
The more speedy way of doing that is to make a single range that references each of those rows and then do a single ".entirerow.hidden = true" statement. And yes, I already have application.screenupdating = false set.
The problem I'm encountering is that if the string reference for the range is too long, it just fails.
The following code declares a function which accepts both a standard array of row numbers (in case the array is made before hand), as well as parameter arguments (in case you don't want to declare an array before hand, and the list of rows is small). It then creates a string which is used in the range reference.
Function GetRows(argsArray() As Long, ParamArray args() As Variant) As Range
Dim rngs As String
Dim r
For Each r In argsArray
rngs = rngs & "," & r & ":" & r
Next
For Each r In args
rngs = rngs & "," & r & ":" & r
Next
rngs = Right(rngs, Len(rngs) - 1)
Set GetRows = Range(rngs)
End Function
Function dfdfd()
Dim selList(50) As Long, j As Long
For i = 1 To 100
If i Mod 2 = 1 Then
selList(j) = i
j = j + 1
End If
Next
selList(50) = 101
GetRows(selList).Select
End Function
The 2nd function "dfdfd" is just used to give an example of when it fails. To see when it works, just make a new array with say - 5 items, and try that. It works.
Final (?) update:
Option Explicit
Public Sub test()
Dim i As Integer
Dim t As Long
Dim nRng As Range
t = Timer()
Application.ScreenUpdating = False
Set nRng = [A1]
For i = 1 To 6000
Set nRng = Union(nRng, Range("A" & i))
Next
nRng.RowHeight = 0
'nRng.EntireRow.Hidden = true
Application.ScreenUpdating = True
Debug.Print "Union (RowHeight): " & Timer() - t & " seconds"
'Debug.Print "Union (EntireRow.Hidden): " & Timer() - t & " seconds"
End Sub
Results:
Union (row height: 0.109375 seconds
Union (hidden row): 0.625 seconds
I think the magical function you're looking for here is Union(). It's built into Excel VBA, so look at the help for it. It does just what you'd expect.
Loop through your ranges, but instead of building a string, build up a multi-area Range. Then you can select or set properties on the whole thing at once.
I don't know what (if any) the limit on the number of areas you can build up in a single Range is, but it's bigger than 600. I don't know what (if any) limits there are on selecting or setting properties of a multi-area Range either, but it's probably worth a try.
A faster option might be to use the SpecialCells property to find the blanks then hide the rows:
Sub HideRows()
Dim rng As Range
Set rng = ActiveSheet.Range("A1:A600")
Set rng = rng.SpecialCells(xlCellTypeBlanks)
rng.EntireRow.Hidden = True
End Sub
This will only work on cells within the UsedRange, I think.
A minor speedup can be obtained if you set the RowHeight property to 0.
On my system it goes about twice as fast
(on 6000 iterations about 1.17 seconds versus 2.09 seconds)
You didn't mention what 'quite a while' is, and what version of XL you are using...
Your problem may be in part your row detect code that checks for a row you want to hide(?).
Here's my test code in XL 2003 (comment out one version then the other):
Option Explicit
Public Sub test()
Dim i As Integer
Dim t As Long
t = Timer()
Application.ScreenUpdating = False
For i = 1 To 6000
With Range("A" & i)
'If .Value = vbEmpty Then .EntireRow.Hidden = True
If .Value = vbEmpty Then .RowHeight = 0
End With
Next
Application.ScreenUpdating = True
Debug.Print Timer() - t & " seconds"
End Sub
There is a limit to the string length. I just encountered a similar problem and found that if the String Txt of
Range(Txt)
is larger then 255 characters my VBA throws an Error.eg. the code:
Debug.Print sheet1.Range("R2300,T2300,V2300,R2261,T2261,V2261,R1958,T1958,V1958,R1751,T1751,V1751,R1544,T1544,V1544,R1285,T1285,V1285,R1225,T1225,V1225,R1193,T1193,V1193,R1089,T1089,V1089,R802,T802,V802,R535,T535,V535,R264,T264,V264,R205,T205,V205,R168,T168,V168,R135,T135,V135,R101").Areas.count
throws an error (256 characters in string) whereas the code
Debug.Print sheet1.Range("R230,T2300,V2300,R2261,T2261,V2261,R1958,T1958,V1958,R1751,T1751,V1751,R1544,T1544,V1544,R1285,T1285,V1285,R1225,T1225,V1225,R1193,T1193,V1193,R1089,T1089,V1089,R802,T802,V802,R535,T535,V535,R264,T264,V264,R205,T205,V205,R168,T168,V168,R135,T135,V135,R101").Areas.count
has 255 characters and prints out "46" without Error. The number of Areas is in both cases the same.

Add visible cells of a range to array

I am trying to get the values of the visible cells of a range into an array.
My code makes the array carry the values until the first non visible cell then stops.
Public Function ListeMaschinen() As Variant
Dim Auswahl As Range
With Sheets("qry_TechnischesDatenblatt")
Set Auswahl = .Range(.Range("A2:B2"), .Range("A2:B2").End(xlDown)).SpecialCells(xlCellTypeVisible)
End With
ListeMaschinen = Auswahl
End Function
If I select the range it shows all the cells I want marked.
Auswahl.Select
Here I have added the range cells to an array.
Sub examp()
Dim rng As Range, cll As Range, i As Integer, a(100) As Variant
Set rng = Range(Range("A2:B2"), Range("A2:B2").End(xlDown)).SpecialCells(xlCellTypeVisible)
i = 0
For Each cll In rng
a(i) = cll.Value
i = i + 1
Next
End Sub
In your code, you are setting a Variant variable equal to a Range object without using the Set statement.
The following works with the little testing I did. Of course, if you declare the function type and other variables as Range type, it also works.
Option Explicit
Sub test()
Dim myVar As Variant
Set myVar = myList()
Debug.Print myVar.Address
End Sub
Public Function myList() As Variant
Dim myRng As Range
With Sheets("Sheet1")
Set myRng = .Range(.Range("A1:B1"), .Range("A1:B1").End(xlDown)).SpecialCells(xlCellTypeVisible)
End With
Debug.Print myRng.Address
Set myList = myRng
End Function
I think your issue is related to
.SpecialCells(xlCellTypeVisible)
When I do this:
Public Function ListeMaschinen() As Variant
Dim Auswahl As Range
With Sheets("qry_TechnischesDatenblatt")
Set Auswahl = .Range(.Range("A2:B2"), .Range("A2:B2").End(xlDown)).SpecialCells(xlCellTypeVisible)
End With
MsgBox Auswahl.Address
Set ListeMaschinen = Auswahl
'Auswahl.Select
End Function
I get an Address composed of 2 parts: the visible parts!
But when I remove the SpecialCells
Public Function ListeMaschinen() As Variant
Dim Auswahl As Range
With Sheets("qry_TechnischesDatenblatt")
Set Auswahl = .Range(.Range("A2:B2"), .Range("A2:B2").End(xlDown))
End With
MsgBox Auswahl.Address
Set ListeMaschinen = Auswahl
End Function
I get one single part, which Is what I get when using Select too.
I tested!
Sub test()
Dim myVar As Variant
Dim i As Integer
i = 0
Set myVar = ListeMaschinen()
For Each C In myVar
i = i + 1
MsgBox C.Value & C.Address & "-" & i
Next
End Sub
Further to my comments earlier, here is a method that will work subject to some limitations:
You can't have more than 65536 rows of data; and
You can't have really long text (911 chars+), or blank visible cells; and
The data should not contain the string "|~|"
If those conditions are met, you can use something like this:
Dim v
Dim sFormula As String
With Selection
sFormula = "IF(SUBTOTAL(103,OFFSET(" & .Cells(1).Address(0, 0) & ",row(" & .Address(0, 0) & ")-min(row(" & .Address(0, 0) & ")),1))," & .Address(0, 0) & ",""|~|"")"
End With
Debug.Print sFormula
v = Filter(Application.Transpose(Evaluate(sFormula)), "|~|", False)
You can adapt this to work round the third limitation by changing the alternate text in the formula string.
Hello :) I was trying to find a way to loop through visible rows in a table without going through all the rows and checking if they are visible as this was consuming too much time on a large table. Below is the solution I was able to come up with. It is a function that returns an array of the absolute row numbers of visible rows in a given Range.
Function GetVisibleRows(LookupRange As Range) As Integer()
Dim VisibleRange As Range, Index As Integer, Area As Range
Static VisibleRows() As Integer
Set VisibleRange = LookupRange.SpecialCells(xlCellTypeVisible)
ReDim VisibleRows(0)
Index = 0
For Each Area In VisibleRange.Areas
If Index = 0 Then
VisibleRows(Index) = Area.Row
ReDim Preserve VisibleRows(Index + 1)
End If
Index = UBound(VisibleRows())
If VisibleRows(Index - 1) <> Area.Row Then
VisibleRows(Index) = Area.Row
ReDim Preserve VisibleRows(Index + 1)
End If
Next
' Remove last empty item
ReDim Preserve VisibleRows(UBound(VisibleRows()) - 1)
GetVisibleRows = VisibleRows
End Function
If you would like to use this function in a lookup scenario, you need to convert the absolute row numbers returned by the function to relative row numbers of the table. Following worked for me.
RowIndex = ReturnedRowIndex - LookupRange.Rows(1).Row + 1
Good luck!

Most efficient way to delete row with VBA

I currently have a macro that I use to delete a record if the ID doesn't exist in a list of ID's I created from an XML document. It does work like I want it to, however I have over 1000 columns in the spreadsheet (one for each day of the year until end of 2015) so it takes ages to delete the row and it can only do 1 or 2 before it says "Excel ran out of resources and had to stop". Below is the code I'm using for the macro, is there another way I can do this so that Excel doesn't run of of resources?
Sub deleteTasks()
Application.ScreenUpdating = False
Dim search As String
Dim sheet As Worksheet
Dim cell As Range, col As Range
Set sheet = Worksheets("misc")
Set col = sheet.Columns(4)
ActiveWorkbook.Sheets("Schedule").Activate
ActiveSheet.Range("A4").Select
ActiveSheet.Unprotect
ActiveSheet.Range("A:C").EntireColumn.Hidden = False
Do While ActiveCell.Value <> ""
search = ActiveCell.Value
Set cell = col.Find(What:=search, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If cell Is Nothing Then 'If the taskID is not in the XML list
Debug.Print "Deleted Task: " & ActiveCell.Value
Selection.EntireRow.Delete
End If
ActiveCell.Offset(1, 0).Select 'Select next task ID
Loop
ActiveSheet.Range("A:B").EntireColumn.Hidden = True
ActiveSheet.Protect
End Sub
After trying lots of different options, including all the answers listed below. I have realized that whatever the method is, deleting a row with ~1100 columns is going to take a while on my average laptop (2.20 Ghz, 4GB RAM). Since the majority of the rows are empty I have found alternative method which is a lot faster. I just clear the cells which contain data (A:S) and then resize the table to remove the row where I just deleted the data from. This end result is exactly the same as entireColumn.Delete. Below is the code I'm using now
'New method - takes about 10 seconds on my laptop
Set ws = Worksheets("Schedule")
Set table = ws.ListObjects(1)
Set r = ws.Range("A280:S280")
r.Clear
table.Resize Range("A3:VZ279")
Using anything involving EntireColumn.Delete or just manually selecting the row and deleting it takes about 20-30 seconds on my laptop. Of course this method only works if your data is in a table.
The short answer:
Use something like
ActiveSheet.Range(DelStr).Delete
' where DelStr = "15:15" if you want to delete row 15
' = "15:15,20:20,32:32" if you want to delete rows 15,20 and 32
The long answer:
Important: If you have ~ 30 / 35 rows to delete, the following code works very efficiently. Beyond which it would throw up an error. For code to handle arbitrary number of rows efficiently see the very long answer below this.
If you have a function which lets you list out which rows you want to delete, try the code below. This is what I use to very efficiently delete multiple rows with minimum overhead. (the example assumes that you've obtained the rows you need to delete through some program, here I manually feed them in):
Sub DeleteRows()
Dim DelRows() As Variant
ReDim DelRows(1 To 3)
DelRows(1) = 15
DelRows(2) = 18
DelRows(3) = 21
'--- How to delete them all together?
Dim i As Long
For i = LBound(DelRows) To UBound(DelRows)
DelRows(i) = DelRows(i) & ":" & DelRows(i)
Next i
Dim DelStr As String
DelStr = Join(DelRows, ",")
' DelStr = "15:15,18:18,21:21"
'
' IMPORTANT: Range strings have a 255 character limit
' See the other code to handle very long strings
ActiveSheet.Range(DelStr).Delete
End Sub
The (very long) efficient solution for arbitrary number of rows and benchmark results:
Here are the benchmark results obtained by deleting rows (Time in seconds vs. no. of rows).
The rows are on a clean sheet and contain a volatile formula in the D column from D1:D100000
i.e. for 100,000 rows, they have a formula =SIN(RAND())
The code is long and not too pretty, but it splits the DelStr into 250 character substrings and forms a range using these. Then the new DeleteRng range is deleted in a single operation.
The time to delete may depend on the contents of the cells. The testing/benchmarking, in congruence with a bit of intuition suggests the following results.
Sparse rows/empty cells delete fastest
Cells with values take somewhat longer
Cells with formulas take even longer
Cells which feed into formulas in other cells take longest as their deletion triggers the #Ref reference error.
Code:
Sub DeleteRows()
' Usual optimization
' Events not disabled as sometimes you'll need to interrupt
' You can optionally keep them disabled
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
' Declarations...
Dim DelRows() As Variant
Dim DelStr As String, LenStr As Long
Dim CutHere_Str As String
Dim i As Long
Dim MaxRowsTest As Long
MaxRowsTest = 1000
' Here I'm taking all even rows from 1 to MaxRowsTest
' as rows to be deleted
ReDim DelRows(1 To MaxRowsTest)
For i = 1 To MaxRowsTest
DelRows(i) = i * 2
Next i
'--- How to delete them all together?
LenStr = 0
DelStr = ""
For i = LBound(DelRows) To UBound(DelRows)
LenStr = LenStr + Len(DelRows(i)) * 2 + 2
' One for a comma, one for the colon and the rest for the row number
' The goal is to create a string like
' DelStr = "15:15,18:18,21:21"
If LenStr > 200 Then
LenStr = 0
CutHere_Str = "!" ' Demarcator for long strings
Else
CutHere_Str = ""
End If
DelRows(i) = DelRows(i) & ":" & DelRows(i) & CutHere_Str
Next i
DelStr = Join(DelRows, ",")
Dim DelStr_Cut() As String
DelStr_Cut = Split(DelStr, "!,")
' Each DelStr_Cut(#) string has a usable string
Dim DeleteRng As Range
Set DeleteRng = ActiveSheet.Range(DelStr_Cut(0))
For i = LBound(DelStr_Cut) + 1 To UBound(DelStr_Cut)
Set DeleteRng = Union(DeleteRng, ActiveSheet.Range(DelStr_Cut(i)))
Next i
DeleteRng.Delete
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
The code to generate the formulas in a blank sheet is
Sub FillRandom()
ActiveSheet.Range("D1").FormulaR1C1 = "=SIN(RAND())"
Range("D1").AutoFill Destination:=Range("D1:D100000"), Type:=xlFillDefault
End Sub
And the code to generate the benchmark results above is
Sub TestTimeForDeletion()
Call FillRandom
Dim Time1 As Single, Time2 As Single
Time1 = Timer
Call DeleteRows
Time2 = Timer
MsgBox (Time2 - Time1)
End Sub
Note: Many thanks to brettdj for pointing out the error which gets thrown when the length of DelStr exceeding 255 characters. It seems to be a known problem and as I painfully found out, it still exists for Excel 2013.
This code uses AutoFilter and is significantly faster than looping through rows.I use it daily and it should be pretty easy to figure out.Just pass it what you're looking for and the column to search in.You could also hard-code the column if you want.
private sub PurgeRandy
Call FindDelete("F", "Randy")
end sub
Public Sub FindDelete(sCOL As String, vSearch As Variant) 'Simple find and Delete
Dim lLastRow As Integer
Dim rng As Range
Dim rngDelete As Range
Range(sCOL & 1).Select
[2:2].Insert
[2:2] = "***"
Range(sCOL & ":" & sCOL).Select
With ActiveSheet
.UsedRange
lLastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
Set rng = Range(sCOL & 2, Cells(lLastRow, sCOL))
rng.AutoFilter Field:=1, Criteria1:=vSearch
Set rngDelete = rng.SpecialCells(xlCellTypeVisible)
rng.AutoFilter
rngDelete.EntireRow.Delete
.UsedRange
End With
End Sub
In this case a simple working formula can be used to see if each of the values in your range to be tested (column A of schedule) exist in column F of misc
In B4 it would =MATCH(A4,misc!D:D,0)
This can be used manually or with code for an efficient delete as the formula by design returns an error if there is no match which we can efficiently delete with VBA with either:
AutoFilter
SpecialCells (the design piece*)
In xl2007 note that there is a limit of 8192 discrete areas that can be selected with SpecialCells
code
Sub ReCut()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng1 As Range
Set ws1 = Sheets("misc")
Set ws2 = Sheets("schedule")
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
Set rng1 = ws2.Range(ws2.[a4], ws2.Cells(Rows.Count, "A").End(xlUp))
ws2.Columns(2).Insert
With rng1.Offset(0, 1)
.FormulaR1C1 = "=MATCH(RC[-1],'" & ws1.Name & "'!C[2],0)"
On Error Resume Next
.Cells.SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete
On Error GoTo 0
End With
ws2.Columns(2).Delete
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub
Note: I don't have enough "reputation" to add my comments thus posting as answer. Credit to hnk for wonderful answer (Long Answer). I have one edit as suggestion:
Once you split the long string and in case the last block is more than the set character then it is having "!" at the end which is throwing error for range method. Addition of IF statement and MID is ensuring that there is no such character.
To handle that, use:
For i = LBound(DelStr_Cut) + 1 To UBound(DelStr_Cut)
If Right(DelStr_Cut(i), 1) = "!" Then
DelStr_Cut(i) = Mid(DelStr_Cut(i), 1, Len(DelStr_Cut(i)) - 1)
Set DeleteRng = Union(DeleteRng, ActiveSheet.Range(DelStr_Cut(i)))
Else
Set DeleteRng = Union(DeleteRng, ActiveSheet.Range(DelStr_Cut(i)))
End If
Next i
Thanks,
Bakul

Range limit conundrum

Is there some limit to what I can select in a range via VBA? Basically what I found is that if I were to hide an entire row while in a loop, it takes quite a while if there are lots of rows to hide.
ex) - Hide any row that doesn't have a value in column A
For i = 1 to 600
With Range("A" & i)
If .value = vbEmpty then .EntireRow.Hidden = True
End With
Next
The more speedy way of doing that is to make a single range that references each of those rows and then do a single ".entirerow.hidden = true" statement. And yes, I already have application.screenupdating = false set.
The problem I'm encountering is that if the string reference for the range is too long, it just fails.
The following code declares a function which accepts both a standard array of row numbers (in case the array is made before hand), as well as parameter arguments (in case you don't want to declare an array before hand, and the list of rows is small). It then creates a string which is used in the range reference.
Function GetRows(argsArray() As Long, ParamArray args() As Variant) As Range
Dim rngs As String
Dim r
For Each r In argsArray
rngs = rngs & "," & r & ":" & r
Next
For Each r In args
rngs = rngs & "," & r & ":" & r
Next
rngs = Right(rngs, Len(rngs) - 1)
Set GetRows = Range(rngs)
End Function
Function dfdfd()
Dim selList(50) As Long, j As Long
For i = 1 To 100
If i Mod 2 = 1 Then
selList(j) = i
j = j + 1
End If
Next
selList(50) = 101
GetRows(selList).Select
End Function
The 2nd function "dfdfd" is just used to give an example of when it fails. To see when it works, just make a new array with say - 5 items, and try that. It works.
Final (?) update:
Option Explicit
Public Sub test()
Dim i As Integer
Dim t As Long
Dim nRng As Range
t = Timer()
Application.ScreenUpdating = False
Set nRng = [A1]
For i = 1 To 6000
Set nRng = Union(nRng, Range("A" & i))
Next
nRng.RowHeight = 0
'nRng.EntireRow.Hidden = true
Application.ScreenUpdating = True
Debug.Print "Union (RowHeight): " & Timer() - t & " seconds"
'Debug.Print "Union (EntireRow.Hidden): " & Timer() - t & " seconds"
End Sub
Results:
Union (row height: 0.109375 seconds
Union (hidden row): 0.625 seconds
I think the magical function you're looking for here is Union(). It's built into Excel VBA, so look at the help for it. It does just what you'd expect.
Loop through your ranges, but instead of building a string, build up a multi-area Range. Then you can select or set properties on the whole thing at once.
I don't know what (if any) the limit on the number of areas you can build up in a single Range is, but it's bigger than 600. I don't know what (if any) limits there are on selecting or setting properties of a multi-area Range either, but it's probably worth a try.
A faster option might be to use the SpecialCells property to find the blanks then hide the rows:
Sub HideRows()
Dim rng As Range
Set rng = ActiveSheet.Range("A1:A600")
Set rng = rng.SpecialCells(xlCellTypeBlanks)
rng.EntireRow.Hidden = True
End Sub
This will only work on cells within the UsedRange, I think.
A minor speedup can be obtained if you set the RowHeight property to 0.
On my system it goes about twice as fast
(on 6000 iterations about 1.17 seconds versus 2.09 seconds)
You didn't mention what 'quite a while' is, and what version of XL you are using...
Your problem may be in part your row detect code that checks for a row you want to hide(?).
Here's my test code in XL 2003 (comment out one version then the other):
Option Explicit
Public Sub test()
Dim i As Integer
Dim t As Long
t = Timer()
Application.ScreenUpdating = False
For i = 1 To 6000
With Range("A" & i)
'If .Value = vbEmpty Then .EntireRow.Hidden = True
If .Value = vbEmpty Then .RowHeight = 0
End With
Next
Application.ScreenUpdating = True
Debug.Print Timer() - t & " seconds"
End Sub
There is a limit to the string length. I just encountered a similar problem and found that if the String Txt of
Range(Txt)
is larger then 255 characters my VBA throws an Error.eg. the code:
Debug.Print sheet1.Range("R2300,T2300,V2300,R2261,T2261,V2261,R1958,T1958,V1958,R1751,T1751,V1751,R1544,T1544,V1544,R1285,T1285,V1285,R1225,T1225,V1225,R1193,T1193,V1193,R1089,T1089,V1089,R802,T802,V802,R535,T535,V535,R264,T264,V264,R205,T205,V205,R168,T168,V168,R135,T135,V135,R101").Areas.count
throws an error (256 characters in string) whereas the code
Debug.Print sheet1.Range("R230,T2300,V2300,R2261,T2261,V2261,R1958,T1958,V1958,R1751,T1751,V1751,R1544,T1544,V1544,R1285,T1285,V1285,R1225,T1225,V1225,R1193,T1193,V1193,R1089,T1089,V1089,R802,T802,V802,R535,T535,V535,R264,T264,V264,R205,T205,V205,R168,T168,V168,R135,T135,V135,R101").Areas.count
has 255 characters and prints out "46" without Error. The number of Areas is in both cases the same.

Resources