I am currently using a lot of For ... Each loops in my code which is slowing it down a lot, is there a faster approach?
I have heard I could copy the range to an array and edit the array and paste it back but im having a few problems with editing each cell in the array.
Here is the current for each code I am using - Thanks.
Dim cell As Range
For Each cell In Sheets("sheet1").UsedRange
cell.Value = cell.Value
Next cell
Try this - MUCH faster and more efficient:
Sheets("sheet1").UsedRange.Value = Sheets("sheet1").UsedRange.Value
Something along these lines:
Dim aCells As Variant
Dim x As Long
Dim y As Long
aCells = Sheets("Sheet1").UsedRange
' Now do something with the array;
' We'll debug.print the contents of each element
' to verify that it matches the cells in the sheet
For x = 1 To UBound(aCells, 1)
For y = 1 To UBound(aCells, 2)
Debug.Print aCells(x, y)
Next
Next
Related
Using VBA, I would like to AND across each row in a 2D array and star the result in separate 1D array without ANDing a single pair the ANDing the result with the next item in that row.
FYI This is my first time using 2D arrays so sorry if there is an obvious solution.
For example if the data in my sheet looked like this (the actual range is much larger):
I would like to do the equlavant of an excel formula: =AND(B2:D2) then =AND(B3:D3), etc...
I have code that sets everything up but I don't know how to proceed except to loop across each element of a row, store the result then loop across the next, etc, etc. I'm hoping the there is a much better (more efficient) way to proceed.
Here is my code so far
Sub Exceptions()
' Setup worksheet
Dim wks As Worksheet
Set wks = cnTest
' Find last row of range
Dim LastRow As Long
LastRow = Find_LastRow(wks) 'Functionthat returns last row
' load range into array
Dim MyArray As Variant
MyArray = wks.Range("B2:D8")
' Setup 1D Result array
Dim Results As Variant
Results = wks.Range("A2:A8")
Dim i As Long
For i = 1 To LastRow
' Perform AND function on each row of the array
' then place result in 1D array (Results())
' If this were a formul: =AND(B2:D2)
'
' Is there way to "AND" across a row in and array or
' must I "AND" MyArray(1,1) with MyArray(1,2) then AND
' that result with MyArray(1,3)
Next i
End Sub
Thank you
Try this.
Sub Exceptions()
' Setup worksheet
' load range into array
Dim MyArray As Variant
MyArray = ActiveSheet.Range("B2:D8")
' Setup 1D Result array
Dim Results As Variant
Results = ActiveSheet.Range("A2:A8")
Dim i As Long
Dim X As Long
For i = 1 To UBound(MyArray, 1)
Results(i, 1) = "True"
For X = 1 To UBound(MyArray, 2)
If MyArray(i, X) = False Then
Results(i, 1) = "False"
Exit For
End If
Next X
Next i
End Sub
Try,
Sub test()
Dim vR()
Dim rngDB As Range, rng As Range
Dim i As Long, r As Long
Set rngDB = Range("b2:b8")
r = rngDB.Rows.Count
ReDim vR(1 To r)
For Each rng In rngDB
i = i + 1
vR(i) = WorksheetFunction.And(rng.Resize(1, 3))
Next rng
Range("a2").Resize(r) = WorksheetFunction.Transpose(vR)
End Sub
In the formula bar, type:
=IF(-PRODUCT(IF(A1,-1,0),IF(C1,-1,0)),TRUE,FALSE)
(if the data is in columns A and C), and drag down.
Because, as everyone knows, A AND B = AB if A and B are Boolean variables (and watch the minus in front of the PRODUCT).
I want make this basic function of "copy&paste-values-on-a-new-row-each-time" run as fast as possible since the macro repeats the calculations hundreds of thousands of times. I just can't find the exact answer after searching this forum for ages.
Currently, I'm copying output numbers from a fixed range and, elsewhere on the worksheet, pasting the values on a new row for each new set of results.
Here's the portion of the code doing this:
Row = Row +1
Range("g15:ax15").copy
Range("ea18").select
ActiveCell.Offset(Row,0).select
Selection.PasteSpecial Paste:=xlPasteValues
Now from what I have found on this forum, I can replace the Copy/Paste functions completely with Range(destination).value = Range(results).value to speed things up. However, I can't figure out how to do this if the destination rows need to be offset by 1 each time. Also, I've read that one could even do away with "select" to speed things up further! How?
There are a number of options:
//This uses the `Destination` key word
Sub CopyAndPaste()
Dim i as long
For i = 1 to 10
Range("g15:ax15").Copy Destination:=Range("ea18").Offset(i, 0)
next i
End Sub
//If you need `PasteSpecial` then you cannot use `Destination` hence this version
Sub CopyAndPaste()
Dim i as long
For i = 1 to 10
Range("g15:ax15").Copy
Range("ea18").Offset(i, 0).PasteSpecial Paste:=xlPasteValues
next i
End Sub
Sometimes reading values into an array first and then writing back to the spreadsheet is quicker. Here is an example:
Sub CopyAndPaste()
Dim i As Long, numbers As Variant, rw As Long
numbers = Range("g15:ax15")
rw = 18
For i = 1 To 10
rw = rw + 1
Range(Cells(rw, 131), Cells(rw, 131 + UBound(numbers, 2) - 1)) = numbers
Next i
End Sub
You can do it without copying as yo mention (using a variant array as you are copying values only, not formats)
X = Range("g15:ax15").Value2
[ea18].Offset(1, 0).Resize(UBound(X, 1), UBound(X, 2)).Value2 = X
or with your variable offset
Dim lngCnt As Long
lngCnt = lngCnt + 1
X = Range("g15:ax15").Value2
[ea18].Offset(lngCnt, 0).Resize(UBound(X, 1), UBound(X, 2)).Value2 = X
Row = Row +1
Range("g15:ax15").copy
Range("ea18").Offset(Row,0).PasteSpecial Paste:=xlPasteValues
Select is a more-or-less useless method inherited from recordings.
Ideally, I would have a range selected and then I would run the macro and I want the macro to essentially run a loop to go through each row so I can extract information from each row until it reaches the end of the range.
For example, A6:B9 are selected, first I want to focus on A6:B6. As in I want to be able to find the min value of the two cells for instance, using my MinSelected function(stated below) which requires a selected range which would ideally be A6:B6. And I want to do this for each row until the end of the original range.
Function MinSelected(R As Range)
MinSelected = Application.WorksheetFunction.min(R)
End Function
Is there any way to do this??? Please tell me to clarify anything that's unclear. Thanks in advance.
You can loop through rows - but looping through a variant array is more efficient (for many rows)
variant aray
Dim X
Dim lngCnt As Long
X = Range("A6:B9").Value2
For lngCnt = 1 To UBound(X)
Debug.Print Application.Min(Application.Index(X, lngCnt))
Next
range approach
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Range("A6:B9")
For Each rng2 In rng1.Rows
Debug.Print Application.Min(rng2)
Next
Use a For loop, Rows.Count property, Columns.Count
Dim i as long
For i = 1 to Selection.Rows.Count
For j = 1 To Selection.Columns.Count
Cells(i, j).Value ' Use this to access the value of cell in row i and column j
I seem to have a strange problem as some ghost values have entered my file. I got this file from someone but looks like file has seen several deletion, copy pastes etc. Please see attached image.
It shows ghost values in cell J186 and the values returned by various IS*** functions on cell j186. Such values are there in several columns in the file and I am sure they are consuming a lot of Filesize and the file is crashing every now and then. The file is 100 MB.
For example, when I select any cell in column L say Cell L56 and press Ctrl+Down, the cursor gets stuck in the cell L186 even when there is no value. If I select the cells L3:L186 and manually enter delete, something gets deleted (I cant see) and then the range functions as a normal range (i.e. If i select any random cell in that range and do a Ctrl+Down, it goes to the last row in Excel Row 1048576) Any cell in the range upto L186 shows the same behaviour as cell J186.
Is there a way to write a VBA code to identify such cells and clear contents of such cells?
Thanks in advance.
Yes, there is something strange here ..... zero length cells that are not actually blank (when tested with SpecialCells(xlBlank)
On your sample file =CODE(A117) returns #VALUE. Yet the cell is not blank
This array based code provides a very quick way of turning the cells to truely blank
Sub QuickReplace()
Dim rng1 As Range
Dim X
Dim lngRow As Long
Dim lngCol As Long
ActiveSheet.UsedRange
X = ActiveSheet.UsedRange.Value2
For lngRow = 1 To UBound(X, 1)
For lngCol = 1 To UBound(X, 2)
If Len(X(lngRow, lngCol)) = 0 Then X(lngRow, lngCol) = vbNullString
Next
Next
ActiveSheet.UsedRange.Value2 = X
End Sub
This code was successful. But the file size did not decrease much.
Sub cleancolumns()
Dim i As Integer
Dim j As Integer
Dim Rng As Range
j = 1
Do While j < 5010
Set Rng = Range(Cells(5, j), Cells(186, j))
If WorksheetFunction.Sum(Rng) = 0 Then
Rng.Select
Selection.ClearContents
j = j + 1
Else
j = j + 1
End If
Loop
ActiveWorkbook.Save
End Sub
There are a million cells in all, also counting the above ranges where full range is "". searching each cell one by one is very slow. Hence I did the above workaround.
The above code checks for the sum of the range and if the sum of the range is zero it is assumed to contain ""'s and clears contents. Else it skips the column and checks for the next column.
However, this does not remedy a situation where there are few genuine values and the rest are ""'s. These also have to be taken into account in a separate If statement i guess. That will make it very slow but doing this appears to be unavoidable.
Update based on Brettdj's response
The following variant of Brettdj's code worked. usedrange appeared to be larger than what my 6GB computer could handle. So I broke the data chunk by chunk to avoid "Out of memory" error. Also there were some error values which had to be removed before the Len function was applied. Now the file sizes have shrunk by a third (mainly by replacing 0's by blanks - there were too many). Thankfully the ghosts seem to have been busted.
Sub QuickReplace1()
Dim rng1 As Range
Dim X As Variant
Dim lngRow As Long
Dim lngCol As Long
' took no more than 500 columns at a time not to risk file crashing. Changed the values manually to clear chunk by chunk
Set rng1 = Range(Cells(1, 3501), Cells(7500, 4000))
X = rng1.Value2
For lngRow = 1 To UBound(X, 1)
For lngCol = 1 To UBound(X, 2)
If IsError(X(lngRow, lngCol)) Then X(lngRow, lngCol) = vbNullString
If X(lngRow, lngCol) = 0 Then X(lngRow, lngCol) = vbNullString
If Len(X(lngRow, lngCol)) = 0 Then X(lngRow, lngCol) = vbNullString
Next
Next
rng1.Value2 = X
End Sub
This is one of those things that I'm sure there's a built-in function for (and I may well have been told it in the past), but I'm scratching my head to remember it.
How do I loop through each row of a multi-column range using Excel VBA? All the tutorials I've been searching up seem only to mention working through a one-dimensional range...
Dim a As Range, b As Range
Set a = Selection
For Each b In a.Rows
MsgBox b.Address
Next
Something like this:
Dim rng As Range
Dim row As Range
Dim cell As Range
Set rng = Range("A1:C2")
For Each row In rng.Rows
For Each cell in row.Cells
'Do Something
Next cell
Next row
Just stumbled upon this and thought I would suggest my solution. I typically like to use the built in functionality of assigning a range to an multi-dim array (I guess it's also the JS Programmer in me).
I frequently write code like this:
Sub arrayBuilder()
myarray = Range("A1:D4")
'unlike most VBA Arrays, this array doesn't need to be declared and will be automatically dimensioned
For i = 1 To UBound(myarray)
For j = 1 To UBound(myarray, 2)
Debug.Print (myarray(i, j))
Next j
Next i
End Sub
Assigning ranges to variables is a very powerful way to manipulate data in VBA.
In Loops, I always prefer to use the Cells class, using the R1C1 reference method, like this:
Cells(rr, col).Formula = ...
This allows me to quickly and easily loop over a Range of cells easily:
Dim r As Long
Dim c As Long
c = GetTargetColumn() ' Or you could just set this manually, like: c = 1
With Sheet1 ' <-- You should always qualify a range with a sheet!
For r = 1 To 10 ' Or 1 To (Ubound(MyListOfStuff) + 1)
' Here we're looping over all the cells in rows 1 to 10, in Column "c"
.Cells(r, c).Value = MyListOfStuff(r)
'---- or ----
'...to easily copy from one place to another (even with an offset of rows and columns)
.Cells(r, c).Value = Sheet2.Cells(r + 3, 17).Value
Next r
End With