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
Related
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.
Here is my current implementation (this is a small section of a much longer script):
Dim j As Integer, q As Integer
q = 2
For j = 1 To 300
If Sheet2.Cells(j, i).Value = "X" Then
Sheet1.Cells(q, 4).Value = Sheet2.Cells(j, 3).Value
If Cells(j, 3).Font.Bold = True Then
Sheet2.Cells(j, 3).Copy
Sheet1.Cells(q, 4).PasteSpecial (xlPasteFormats)
End If
q = q + 1
End If
Next j
This code is looping through a range and finding values that have an X in another column, that's for something else. But I am trying to also get it to copy over specifically the bold formatting. This implementation "works" in that it runs, but confusingly, it only picks up on the bold formatting sometimes, and usually only the first bold entry in a group of bold entries.
I can't have it just copy over every single one, because while that works, it also runs slowly and is generally ugly. Maybe if I included a DoEvents = false it wouldn't be so bad, but still.
Because you're copying and pasting values elsewhere, it's generally a good idea to clear the clipboard after each copy. This may also affect the performance (in a positive way).
Add the following code to immediately after your PasteSpecial line:
Application.CutCopyMode = False
Does the sheet contain any conditional formatting rules that may break?
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.
I'm trying to get Excel to list every variation of a certain value.
If A1= ABC1904
& A2= ABC1910
I'd like column B to list.
ABC1904
ABC1905
ABC1906
ABC1907
ABC1908
ABC1909
ABC1910
This is the best I could do w/ a purely formula solution:
=LEFT(A$1,3) & MID(A$1,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A$1&"0123456789")),LEN(A$1))+MIN(RIGHT($A$2,1)+0,ROWS(A$1:A1)-1)
It leaves a bit to be desired because you'll have a bunch of duplicates if you drag the formula too far down.
If you're not opposed to a VBA solution, you could give this a go:
Sub VariationOfValue()
Dim startNumber As Long, _
endNumber As Long, _
counter As Long
Dim leadingString As String
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
counter = 1
With Sheet1
leadingString = Left(Sheet1.Range("A1").Value, 3)
startNumber = Evaluate("=MID(A$1,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A$1&""0123456789"")),LEN(A$1))") + 0
endNumber = Evaluate("=MID(A$2,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A$2&""0123456789"")),LEN(A$2))") + 0
Do While startNumber <= endNumber
.Range("B" & counter).Value = leadingString & startNumber
counter = counter + 1
startNumber = startNumber + 1
Loop
End With
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Does basically the same thing, but only until the last number is reached. Either way, hope one or both of these helps out a bit.
If you are willing to have a few columns to achieve this then it is really not very difficult.
Col A is your starting data. [ABC1904 and ABC1910}
Col B contains equations =VALUE(RIGHT(A1,LEN(A1)-3)) which gives the numeric part of the strings. [1904 and 1910]
Col C contains equations =IF(OR(C2=B$2,C2=""),"",C2+1) - except C1 which is just =b1
- this gives the series of numbers you want {1904 to 1910]
Col D contains equations =IF(C1="","",LEFT(A$1,3)&C1)
- this puts the text back on the front of the numbers [ABC1904 to ABC1910]
..this would be clearer with a screenshot but I apparently do not have enough reputation to post one
Ive written a macro that takes some source data and writes it onto several sheets, which id like to remain hidden before and after the macro has run. Having written the Macro, when I run it it only updates a few records on each sheet (for instance on the first hidden sheet it updates 21 rows out of over 1000. What is the reason for this happening? Surely it should update them all or none of them? Im not getting any errors either. Ive tried
Application.ScreenUpdating = False
Worksheets("FT Raw").Visible = True
Worksheets("L1").Visible = True
Worksheets("L2").Visible = True
Worksheets("L3").Visible = True
Worksheets("L4").Visible = True
But still only 21 rows get updated.
Update: This is the code that is running on each sheet
endval = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To endval
If Not Sheets("FT Raw").Cells(i, "A") = "" Then
splitted = Split(Sheets("FT Raw").Cells(i, "A"), ",")
Sheets("FT Raw").Cells(i, "B") = splitted(0)
Sheets("FT Raw").Cells(i, "C") = splitted(1)
Sheets("FT Raw").Cells(i, "D") = splitted(2)
If Sheets("FT Raw").Cells(i, "D") = "1" Then
Sheets("L1").Cells(j, "A") = Trim(splitted(0))
Sheets("L1").Cells(j, "B") = Trim(splitted(3))
j = j + 1
End If
End If
Next i
Ok Edit. You need to specify the Sheet("FT Raw") in your endval calc.
Try this set endval = Sheets("FT Raw").Cells(Sheets("FT Raw").Rows.Count, 1).End(xlUp).Row and proceed with the remainder of your code.
(You could also use endval = Sheets("FT Raw").UsedRange.Rows.Count only if you don't have blank cells at the top of the column)
Lucky last, you don't have to unhide these sheets at all to run the code. By all means do so to debug but when running in anger it's not necessary.
This has nothing to do with the hiding of sheets - even if a sheet is hidden, you can still modify it with VBA. (Only if it is protected, you need to unprotect it.)
Lookig at your code, I do not see, where j is initialized - and under which circumstances column D in your sheet FT rawis equal to "1".
I suggest you initialize j in the top, e.g. if you want to add the rows using
j = Sheets("L1").Range(Rows.Count, 1).End.(xlUp).Row + 1
Then, after running the macro (for a check), filter column D in your raw sheet with an Autofilter for the value 1 and see if that matches the number of entries in sheet L1.