I have an excel calculation that completes one iteration in 10 columns (+1 column for space for 11 total columns per set). My intention is to copy this range of 11 columns a number of times (ideally 350 or more) using VBA. Each time the range is copy/pasted, that iteration of the calcuation references the previous set for a "cascade" effect.
I've pieced together some VBA code that accomplishes this task but is incredibly slow to process and it is difficult to tell if the calcuation is working as intended at the larger end of the iteration scheme. I added a status bar to track the progress and I have noticed that operation grinds to a halt after 100 or so iterations. I currently have the count set to 100 iterations because that seems to be the point where it struggles.
I've looked around on here for help before asking this and discovered the Application.ScreenUpdating = False trick but that doesn't seem to solve the issue.
How do I optimize what I currently have? Is there a better way to go about doing this?
Sub CascadeCopy2()
Dim i As Integer, x As Integer
Dim count As Integer
Application.ScreenUpdating = False
count = 100
For i = 1 To count
With Sheets("Calc").Range("V3:AF250").Offset(0, x)
.Copy
.Offset(0, 11).PasteSpecial
Application.CutCopyMode = False
x = x + 11
End With
Application.StatusBar = "Progress: " & i & " of " & count & ":" & Format(i / count, "0%")
Next i
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub
To copy a range repeatedly across a worksheet, you need to do a for loop. You can use the equals method, but you will have to do two actions to copy the formulas, see below.
Dim x As Long
x = 1
For i = 1 To 299 'the number of times you want to copy, change as needed
With Sheets("Calc").Cells(1, x + 32).Resize(250, 32)
.Value = Sheets("Calc").Cells(1, x).Resize(250, 32).Value
.Formula = Sheets("Calc").Cells(1, x).Resize(250, 32).Formula
End With
x = x + 32
Next i
Turning off Application.ScreenUpdating is a good start.
Copy-Pasting huge amount of data in loops can become painfully slow, because copy-paste requires using the clipboard, which isn't very efficient.
Try accessing you range directly, using something like this:
Sheets("Calc").Range("V3:AF250").Offset(0,x).value = Sheets("Calc").Range("V3:AF250").Offset(0,11).value
You can then also use the same principle to copy formatting, or colors, or font size, etc, with the same template. For example :
Sheets("Calc").Range("V3:AF250").Offset(0,x).Interior.ColorIndex = Sheets("Calc").Range("V3:AF250").Offset(0,11).Interior.ColorIndex
You can easily adapt it to your needs.
Related
I have implemented this method to multiply every array element by a number held in a variable. It is terribly slow.
Is there an accepted "fastest" way to multiply every element in a range by a constant? Or at least one which is not as slow? I have to do this 10 times and it takes a couple of minutes.
MultFactor = 10
For Each cell In Sheet1.Range("B3:B902")
cell.Value = cell.Value * MultFactor
Next cell
The solution cited in Multiply Entire Range By Value? multiplies by a constant (not a variable). If I use this code (changing the range from "A1:B10" to "B3:B902"), I get a nonsense answer.
Dim rngData As Range
Set rngData = Sheet12.Range("B3:B902")
rngData = Evaluate(rngData.Address & "*2")
My original values in B3:B902 are zero for the first 100 elements or so and then increase a bit and finally decrease and have another run of zeros, but what ends up in my range is a series of numbers that clobbers everything in my range. It begins at -224.5 and decreases by 0.5 all the way to the last cell.
-224.5
-224.0
-223.5
etc.
Even if that worked, how would I modify it to use the variable MultFactor?
This will be hundreds to thousands of times faster. The difference is that all of the calcs are done to a VBA array instead of directly to worksheet cells, one by one. Once the array is updated it is written back to the worksheet in one go. This reduces worksheet interaction to just two instances, reading the array and writing it. Reducing the number of instances that your VBA code touches anything on the worksheet side is critical to execution speed.
Sub Mozdzen()
Const FACTOR = 10
Const SOURCE = "B3:B902"
Dim i&, v
v = Sheet1.Range(SOURCE)
For i = 1 To UBound(v)
v(i, 1) = v(i, 1) * FACTOR
Next
Sheet1.Range(SOURCE) = v
End Sub
Building on the above idea, a better way to manage the code is to encapsulate the array multiplication with a dedicated function:
Sub Mozdzen()
Const FACTOR = 10
Const SOURCE = "B3:B902"
With Sheet2.Range(SOURCE)
.Value2 = ArrayMultiply(.Value2, FACTOR)
End With
End Sub
Function ArrayMultiply(a, multfactor#)
Dim i&
For i = 1 To UBound(a)
a(i, 1) = a(i, 1) * multfactor
Next
ArrayMultiply = a
End Function
You need:
rngData = Sheet12.Evaluate(rngData.Address & "*2")
since the address property doesn't include the sheet name by default (so your formula is evaluated in the context of the active sheet's range B3:B902)
Then it would need:
rngData = Sheet12.Evaluate(rngData.Address & "*" & MultFactor)
to add in your variable.
I've been working with Excel-VBA for a few weeks now, and have learned a lot, especially from StackOverflow. I just have one problem that's beyond me.
I've made an Excel workbook for a price list in 6 versions. It has to be designed so that only one version has to be corrected in case of changes or errors; the other versions will be changed with the press of a button. Everything works, except for one thing: I want row heights to change based on the font size of one cell in that row.
Specifically, the third column sometimes contains headers with a font size of 20. In that case, the row height needs to be 26.25. In all other cases, the row height must be 12.75. Currently I'm using the following code. It seems to work, but it's painfully slow:
For j = 1 To lastrow
If Cells(j, 3).Font.Size = 20 Then
Rows.Cells(j, 3).RowHeight = 26.25
Else
Rows.Cells(j, 3).RowHeight = 12.75
End If
Next j
I've tried some other things, including the following code (with cell and nicrange declared as Range), but that doesn't work:
For Each cell In nicrange
If cell.Font.Size = 20 Then
cell.RowHeight = 26.25
Else
cell.RowHeight = 12.75
End If
Next
It's probably just a simple mistake, but I can't figure it out. Any help would be much appreciated. Thank you!
Sander
Use this approach to get the lastRow. Then, simplify your condition:
For j = 1 To lastrow
With Cells(j,3)
.RowHeight = IIF(.Font.Size = 20, 26.25, 12.75)
End With
Next
If lastRow is a very large number, then this requires many iterations, and can usually be optimized by disabling ScreenUpdating and Calculation
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For j = 1 To lastrow
With Cells(j,3)
.RowHeight = IIF(.Font.Size = 20, 26.25, 12.75)
End With
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
I'm using Excel to generate numbers from a basic formula that has 2 variables. I have 600 numbers (specifically coordinates), that I need to generate 13 new numbers from each (so I'll need a total of 8400 values/rows for each X & Y). Since the formula will need to change every 14 rows to a new absolute cell, I am having a hard time thinking of how to accomplish this in Excel using VBA.
My current thought is this:
Add rows to accommodate for the new values.
Fill down columns C and D with the repeating pattern of values.
Create a loop that runs the formula for 14 rows then repeats, keeping the absolute value based on position (?).
Admittedly, I am not a pro at VBA, so any help on how to accomplish this task is greatly appreciated.
See screen grab of data, below, for an example.
Snippet of Data
I used this code to get 13 new rows for my values.
Sub AddRows()
ScreenUpdating = False
With ActiveSheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Dim AddRows As Integer: AddRows = 13
Dim i As Integer: i = lastRow
Do While i <> 1
Rows(i & ":" & i + AddRows - 1).Insert
i = i - 1
Loop
ScreenUpdating = True
End Sub
I have a spreadsheet, BO2009, that is 300k rows long. Only one column contains a formula The others are all pasted values so only one formula needs to be calculated in the entire workbook. Here is the formula: =IFERROR(INDEX('RE2009'!H:H,MATCH('BO2009'!A2,'RE2009'!A:A,0)),1) This formula is copied down to the bottom of the sheet, so 300k times.
RE2009 sheet has 180k rows. 'RE2009'!H:H contains decimal numbers and 'RE2009'!A:A, 'BO2009'!A:A contain ID codes--an 8 character combination of numbers and letters. Both 'RE2009'!A:A, 'BO2009'!A:A are formatted as general.
I use INDEX/MATCH all the time and while most of my spreadsheets are not 300k long, 60k-100k is typical. Right now it takes a couple minutes of my CPU devoting 99% to Excel in order to finish the calculation.
Is that normal? Is there any way to improve Excel's performance?
On top of that I am getting inaccurate results: instead of 0.3 the lookup produces an error.
As suggested, I have filtered the BO2009 sheet down to 80k rows, but still have the same issues. I decided to look at a single formula in particular: =IFERROR(INDEX('RE2009'!H:H,MATCH('BO2009'!A108661,'RE2009'!A:A,0)),1) to see if it worked correctly. The ID that it is looking for with the MATCH function is the 3rd entry in the lookup array, but it still isn't able to produce the correct value (0.3)
It seems that you've found a satisfactory solution to your problem(s) but as a matter of curiosity, you may wish to time this against your current formula based solution to see if there is a measurable increase in speed.
Sub index_match_mem()
Dim v As Long, vVALs As Variant, vTMP As Variant
Dim dRE2009 As Object
Debug.Print Timer
Application.ScreenUpdating = False
With Worksheets("RE2009")
With .Cells(1, 1).CurrentRegion
With .Resize(.Rows.Count, 8)
vTMP = .Cells.Value2
End With
End With
End With
Set dRE2009 = CreateObject("Scripting.Dictionary")
dRE2009.CompareMode = vbTextCompare
For v = LBound(vTMP, 1) To UBound(vTMP, 1)
If Not dRE2009.exists(vTMP(v, 1)) Then _
dRE2009.Add Key:=vTMP(v, 1), Item:=vTMP(v, 8)
Next v
With Worksheets("BO2009")
With .Cells(1, 1).CurrentRegion
With .Resize(.Rows.Count - 1, 2).Offset(1, 0)
vVALs = .Cells.Value2
For v = UBound(vVALs, 1) To LBound(vVALs, 1) Step -1
If dRE2009.exists(vVALs(v, 1)) Then
vVALs(v, 2) = dRE2009.Item(vVALs(v, 1))
Else
vVALs(v, 2) = 1
End If
Next v
.Cells = vVALs
End With
End With
End With
dRE2009.RemoveAll: Set dRE2009 = Nothing
Application.ScreenUpdating = True
Debug.Print Timer
End Sub
This will produce static values in column B of the BO2009 worksheet. The elapsed start and stop in seconds will be in the VBE's Immediate window (Ctrl+G)
I have a pretty basic loop that I am using to run some random scenarios. On one of my worksheets I am using the =Rand() function to generate random numbers/scenarios for my workbook. What I am trying to program from there is a macro that refreshes the workbook (and the random set of numbers) and then deposits my results onto my worksheet each time the scenario is run. Ultimately, I'd like to be able to run/generate 100,000 random scenarios and deposit the results. Here is what I've coded so far:
Sub Run()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wksInput As Worksheet, i As Integer
Set wksInput = Sheets("Input")
For i = 2 To 102
Application.Calculate
With wksInput
.Range("P" & i).Value = .Range("J35").Value
.Range("Q" & i).Value = .Range("K35").Value
.Range("R" & i).Value = .Range("L35").Value
.Range("S" & i).Value = .Range("G32").Value
End With
Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
What I have here works just fine, except that it takes 23 seconds to run just 100 scenarios. Based on my calculation that would require over 6 hours of run time to get my 100,000 random scenarios.
My question is does anyone know of a clever way to either change the code to run more efficiently or optimize what I already have. I done all the basic things like turning calculation to manual and turning off screenupdating.
Thanks for your ideas.
The problem is this line:
Application.Calculate
As it's placed inside the For i = 2 To 102, it means that for every row you add all the =rand() functions of the spreadsheet are recalculated.
May I suggest you to generate the random numbers within the code, using the Rnd() built-in function of VBA. Like that, you will generate only the random input you need avoiding to generate the N-1 other inputs that you will regenerate anyway at the Next loop when calling Application.Calculate once again.
what might that look like?
This is the logic (I cannot tell you specifically because you didn't show your whole code/spreadsheet nor the logic behind this random generation): let's say that you have three random numbers in the cells A1, A2 and A3. They are all calculated with a function =Rand() inside the cell.
Now, with your code, you want that in B1, B2 and B3 there is the sum of the random number in A + 1.
the Excel solution (i.e. Excel calculates the random inputs with the function =Rand()):
For j = 1 To 3
Application.Calculate '<-- this re-calculates 3 =rand(), but you need only the one you're going to use right after (==j)
Range("B" & j) = Range("A" & j) + 1
Next j
the VBA solution (i.e. the random numbers are not in the Excel spreadsheet but calculated through VBA):
Randomize
For j = 1 To 3
Range("A" & j) = Rnd() '<-- you insert the random value in A1, A2...
Range("B" & j) = Range("A" & j) + 1 '<-- you use it
Next j
The Excel solution calculates 3 random functions for 3 times, i.e. 9 iterations. The VBA solution calculates 1 random function for 3 times, i.e. 3 iterations.
I let you imagine the multiplication for 100,000 scenarios with 100 data each.