I have created an array in which each element is a number of row I want to delete from the worksheet.
The only issue is that deleting rows from the top of the worksheet would shift position of other rows.
Therefore, please advise how to loop through the array from the bottom to the top (backwards).
(...)
For Each r In rowArray()
Cells(r, 5).Rows.EntireRow.Delete
Next r
(...)
For Each...Next loops vastly outperform For...Next loops for iterating object collections (source), and For...Next loops outperform For Each...Next loops for iterating an array. So, use a For loop if you're iterating an array, and a For Each loop it you're actually iterating the invidivual cells of a Range.
Consider using Union instead of iterating rows backwards, to join the rows you want to delete into a single Range object, which you an delete in a single worksheet operation - that will vastly outperform the backwards-loop.
Private Function Combine(ByVal source1 As Range, ByVal source2 As Range) As Range
If source1 Is Nothing Then
Set Combine = source2
Else
Set Combine = Union(source1, source2)
End If
End Function
Something like this (untested air-code):
Dim toDelete As Range, i As Long
For i = LBound(rowArray) To UBound(rowArray)
Set toDelete = Combine(toDelete, rowArray(i))
Next
If Not toDelete Is Nothing Then toDelete.EntireRow.Delete
That way toggling Application.Calculation to manual, disabling Application.EnableEvents and setting Application.ScreenUpdating to False will have little to no impact whatsoever on overall performance, because you're only interacting with the sheet when you have to, whereas deleting each row individually will fire worksheet events, prompt recalculations and screen repaints at every single iteration.
Use a counter loop and the step command:
Dim x as Integer
For x = 10 to 1 Step -1
myWorksheet.Rows(x).Delete
Next x
If you have numbers in an array, it would be something like:
For x = ubound(myArray) to 0 step -1
rows(myArray(x)).Delete
next x
Step is used to indicate how many iterations to jump, so you could use Step 2 for every other row, or Step -5 for every 5th row backwards.
Related
I'm having some trouble to wrap my head around an array problem.
I collect data from a sheet and stores it into an array. xData(0) will be completed and can not miss data. But xData(1) there the values are stored may miss a value so I want to replace the empty cell with a 0. Instead of using for loops to add 0 into the sheets I'm thinking of using an array, due to the reason that I cant find a way to add 0 directly to the sheet without decreasing the speed. I have around 10 sheets in 15 different workbooks and therefor I need to find a faster way to do this.
My code snippet is as following.
Dim xData(1) As Variant
'Collect the data from the sheets ()
xData(0) = xData(1) = Application.Transpose(Range(Cells(1, 1), Cells(1, 1).End(xlDown)).Value2)
xData(1) = xData(1) = Application.Transpose(Range(Cells(1, 2), Cells(1, 2).End(xlDown)).Value2)
This will produce a 2D array but the xData(1) will not be the same size as xData(0) if any cell is empty (missing data). Is there a way to change the size of xData(1) to fit the size of xData(0), and then add 0 to the remaining length. Is there any other way because this may cause problems later on too because of the case if 1 value is missing in the middle.
If your goal is to replace empties with zeros, here is the core of an approach that:
avoids loops
avoids VBA arrays
Say we have data in column A from A1 through A1000 with some empties in that range. Running:
Sub ChangeEmpty2Zero()
Dim rng As Range, rngE As Range
Set rng = Range("A1:A1000")
On Error Resume Next
Set rngE = rng.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not rngE Is Nothing Then rngE = 0
End Sub
will fill those empties with zeros.
NOTE:
If the "bottom of the column is outside UsedRange, that "bottom" will not be changed.You could adapt this to run on whatever ranges in whatever worksheets you need.
I have the beginning of a macro here to shift a collection of cells either one to the right or left, based on a macro button on that row. I'll need to copy the macro button for 500 cells in a column so the application.caller part is necessary.
Sub ShiftTheRow()
Dim sh As Shape
Dim rngMove As Range
Dim rngAnchor As Range
Set sh = ActiveSheet.Shapes(Application.Caller)
Set rngAnchor = sh.TopLeftCell
'Find numerical cells
On Error Resume Next
Set rngMove = rngAnchor.Columns("X:DC").SpecialCells(xlCellTypeConstants, xlNumbers)
On Error GoTo 0
If rngMove Is Nothing Then
'No numbers found
Exit Sub
Else
rngMove.Cells(1).Insert shift:=xlShiftToRight
End If
End Sub
Unfortunately (as you would expect) it moves the entire row one to the right, when I need the shifting of cells to be constrained between columns AO:DC.
(e.g I want all cells between A:AN for that row to remain unaffected, and all those from DE:onward to be unaffected also)
However I simply cannot figure out how to do this.
I have tried...
Set rngMove = rngAnchor.Columns("AO:DC").SpecialCells(xlCellTypeConstants, xlNumbers)
But for some strange reason it will begin shifting cells at BB and go beyond DC.
Really at a loss here!
Here's a small function that will shift cells left or right without affecting other cells outside the desired range:
Sub shiftLeftRight(shiftRange As Range, leftRight As Integer)
'=== Note: pass leftRight as 1 or -1
shiftRange.Cut
shiftRange.Cells(1, 1).Offset(, leftRight).Select
ActiveSheet.Paste
End Sub
I will leave how you determine and pass the range up to you, but I know there's a better solution than 500 separate buttons.
Hello I have two dimensional array as below in LotusScript.
Counter = 0
While Not (ProcessingViewDoc Is Nothing )
Redim Preserve AllRecrods(Counter,0)
AllRecrods(Counter,0) = ProcessingViewDoc.Test1(0)
Redim Preserve AllRecrods(Counter,1)
AllRecrods(Counter,1) = ProcessingViewDoc.Test2(0)
Redim Preserve AllRecrods(Counter,2)
Set ProcessingViewDoc = ProcessingView.GetNextDocument(ProcessingViewDoc)
Counter = Counter +1
Wend
When It processes next document it does and reaches to counter 1 and second document it gives me error subscription out of range.
Here is global declaration of array.
Dim AllRecrods() As Variant
Here is the line when it gives error when it goes to loop second time.
Redim Preserve AllRecrods(Counter,0)
In addition to Richard's excellent answer, I would suggest a couple of things.
1) Instead of While Not (ProcessingViewDoc Is Nothing) (which contains two negatives, making it harder to read), use Do Until doc Is Nothing. It is much clearer.
2) If you use a list, you don't have to worry about redim of the array. You could make it a list of a custom data type, and if you use the UNID of the document as the key, you can quickly connect the values back to the originating document.
My code would look something like this:
--- Declarations ---
Type recordData
value1 As String
value2 As String
End Type
--- Main Code ---
Dim allRecords List As recordData
Dim unid as String
Do Until ProcessingViewDoc Is Nothing
unid = ProcessingViewDoc.UniqueID
allRecords(unid).value1 = ProcessingViewDoc.Test1(0)
allRecords(unid).value2 = ProcessingViewDoc.Test2(0)
Set ProcessingViewDoc = ProcessingView.GetNextDocument(ProcessingViewDoc)
Loop
You are using ReDim with the Preserve option and changing both of the dimensions. You can't do that.
From the documentation for the ReDim statement:
If Preserve is specified, you can change only the upper bound of the
last array dimension. Attempting to change any other bound results in
an error.
Also, the logic there is screwed up. You're doing three redims on every iteration, with the first one shrinking the second dimension back to zero on every iteration. Even if you weren't changing the first dimension, that would lose the data that you stored in AllRecrods( n ,1) because the preserve option can't keep data in a dimension that you shrink below the size that you've already used!
You should probably consider swapping your two dimensions, reversing them in your assignments, keeping the first dimension constant at 2, and eliminating two of your ReDim Preserve statements. I.e., just do one ReDim Preserve AllRecrods(2,counter) on each iteration of the loop.
I am trying to filter an array of 20000 rows and 70 columns by a particular column. I want to copy the whole row to another array if the value in column 14 is "Hard". I came up with a very simple implementation and tried using it but Excel went Not Responding everytime crashed eventually. Then I added DoEvents in the loop so that excel does not crash. My code looks as follows for now. It would help a lot if the community could help me optimize it. It is taking way too much time right now.
Is there some other function I can use to slice the array, instead of Index, that would be working faster?
Dim arr_all() As Variant
Dim arr_Hard(1 To 20000) As Variant
Dim arr_Soft(1 To 20000) As Variant
Dim arr_Travel() As Variant
arr_all = wsCopyTo.Range("A2:BR20000").Value
m = 1
n = 1
For i = LBound(arr_all) To UBound(arr_all)
DoEvents
Select Case arr_all(i, 14)
Case "Hard"
arr_Hard(m) = Application.Index(arr_all, i)
m = m + 1
Case "Soft"
arr_Soft(n) = Application.Index(arr_all, i)
n = n + 1
End Select
Next i
The Solution
Sort the items in the original Worksheet by the Hard/Soft column (desc or asc no matter). If you can't sort for some reason then copy the original worksheet to a new one.
Find the row where Hard/Soft items end - simply count the number of Hard or Soft with COUNTIF, whichever comes first, and get the required ranges of cells FROM and TO for both Hard and Soft items
Use the wsCopyTo.Range("A[FROM]:BR[TO]").Value to simply copy the part of Hard and Soft to array arr_Hard and array arr_Hard
I have a dynamic array ,where the array size changes according to the no.of rows in database
code goes like this :
Dim pgm_act_arr(0) As Double
Dim pgm_act_count As Integer = no.of rows retuned from database
ReDim pgm_act_arr(pgm_act_count)
for each rows in database1
'i want to reinitialize the array here
'now am using for loop to reinitialize array to zero
For i As double to pgm_act_arr.Length
pgm_act_arr(i) = 0.0
Next
for each rows in database2
pgm_act_arr(index)+=somevalue 'inserting values to array elements
next
next
Is there any single line code or any short hand operations to reinitialise the array
Not entirely sure i have understood the Q but....
Not sure if it is the right way but i always redim as i go so code would look like this:
Dim pgm_act_arr(0) As Double
for each rows in database2
pgm_act_arr(index)+=somevalue 'inserting values to array elements
ReDim preserve pgm_act_arr(ubound(pgm_act_arr)+1)
next
'remove blank entry at bottom
ReDim preserve pgm_act_arr(ubound(pgm_act_arr)-1)
To reset the array to as it started
ReDim pgm_act_arr(0)
So consider array size as 3
i.e.
pgm_act_arr(0)=1
pgm_act_arr(1)=2
pgm_act_arr(2)=3
so what i want to do is
pgm_act_arr(0)=0
pgm_act_arr(1)=0
pgm_act_arr(2)=0
But as far as i know this is the simplest way
for i=0 to 2
pgm_act_arr(i)=0.0
next