I have a workbook that takes more than 6 seconds to open due to a number of macros that run within the workbook_open event.
I want to speed this up so I have used a timer to test different parts of the code at startup vs being run while the workbook is open. All of the parts take the same time to run in both situations, except this part:
Dim ATime As Double
Dim BTime As Double
ATime = timer
Dim b As Long
For b = 5 To 268
If Sheets("Orders").Range("F" & b) = "Locked" Then
Sheets("Orders").Range("C" & b).Locked = True
Sheets("Orders").Range("D" & b).Locked = True
Sheets("Orders").Range("E" & b).Locked = True
End If
Next
BTime = timer
MsgBox "1. " & Format(BTime - ATime, "0.00 \s\ec")
When run at workbook_open: 2.78 seconds. When run manually within workbook: 0.01 seconds.
What is the problem here?
Try:
With Sheets("Orders")
For b = 5 To 268
.Range("C" & b).Resize(1, 3).Locked = (.Range("F" & b) = "Locked")
Next
End With
Related
I have a program that creates 100 000 objects of class Client, puts them into array and then goes through that array 100 times, each time assigning each Client a different random number through Rnd() function:
Main sub:
Sub start()
Dim i As Long
Dim j As Long
Dim clientsColl() As Client
ReDim clientsColl(1 To 100000) As Client
For j = 1 To 100000
Set clientsColl(j) = New Client
clientsColl(j).setClientName = "Client_" & j
Application.StatusBar = "Getting client " & j
DoEvents
Next
Dim tempCount As Long
Dim clientCopy As Variant
For i = 1 To 100
tempCount = 0
For Each clientCopy In clientsColl
tempCount = tempCount + 1
clientCopy.generateRandom
'Application.StatusBar = "Calculating " & i & ": " & tempCount & "/" & 100000 '(1)
'DoEvents
Next
Application.StatusBar = "Calculating " & i
DoEvents
Next
MsgBox ("done")
End Sub
Client class:
Option Explicit
Dim clientName As String
Dim randomNumber As Double
Public Sub generateRandom()
randomNumber = Rnd()
End Sub
Public Property Get getClientName()
getClientName = clientName
End Property
Public Property Let setClientName(value As String)
clientName = value
End Property
The problem is, the execution time depends on whether or not line (1) is commented out. If it's executed, the statusbar gets renewed, but the execution time is very slow. If it's not executed, the program gets done really fast.
Why does this happen?
VBA is fast enough as long as you stay within. Whenever you turn to Excel, it may get much slower because Excel makes thousands of operations every time it gets control. You may consider turning off a few more services of Excel like I do in my applications:
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
... and as far as I know DoEvents is the best way to make Excel update the status bar when you turn off automatic updates.
Another timesaving workaround can be to display only every 100th or 1000th message from within the inner loop.
when doing a progressbar or statusbar, you need to use it wisely.
Basically the progress info needs to be refreshed only every 0.1 seconds or so.
Knowing your max number of loops , and the time it takes, you might want to update the info only every (in your case) , let's say, 100 iterations of the loop.
This is done like this: if j mod 100=0 then application.statusbar="..." : doevents
Usually i even go further by using doevents less than my progressbar (second if j mod).
I have created macro in Excel VBA to perform iterative operations. The intention of this code is to paste the values from one range of cells, which contain formulas, into another range.
In this code, I have specified the location of the ranges (both for the ones being copied and for the ones being pasted).
During the modification of the Excel Model, I change the number of rows or columns (by adding or deleting), thus changing the actual location of the range of cells. As an example, what used to be Range("N786:BT786") can become Range("N650:BT650").
I would certainly appreciate if you could help to modify my code so that the ranges would not be fixed to the static location, but rather automatically update as the model itself is being updated.
Thank you in advance.
Below you may find my code.
Option Explicit
Sub calculations_update()
Application.DisplayStatusBar = False
Application.ScreenUpdating = False
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
Do While i < 95
i = i + 1
ThisWorkbook.Worksheets("Electrity").Activate
Range("N786:BT786").Value = Range("N787: BT787").Value
Range("R826:BT826").Value = Range("R827: BT827").Value
ThisWorkbook.Worksheets("Efficiency").Activate
Range("H814").Value = Range("H815").Value
Range("H826").Value = Range("H827").Value
Range("H846").Value = Range("H847").Value
Loop
SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "The update was successful in " &SecondsElapsed& " seconds", bInformation
End Sub
In order to avoid using static cell addresses within your code, it is usually better to assign names to the relevant cells (using Formulas / Name Manager within Excel) and then use those names in your code.
Assuming you assigned names (with "Workbook" scope) to your ranges as follows:
Range Name
Electricity!$N$786:$BT$786 DstRng1
Electricity!$N$787:$BT$787 SrcRng1
Electricity!$R$826:$BT$826 DstRng2
Electricity!$R$827:$BT$827 SrcRng2
Efficiency!$H$814 DstRng3
Efficiency!$H$815 SrcRng3
Efficiency!$H$826 DstRng4
Efficiency!$H$827 SrcRng4
Efficiency!$H$846 DstRng5
Efficiency!$H$847 SrcRng5
(obviously, you could use more meaningful names if you like)
the following code could be used:
Option Explicit
Sub calculations_update()
Application.DisplayStatusBar = False
Application.ScreenUpdating = False
Dim StartTime As Double
Dim SecondsElapsed As Double
Dim i As Long
StartTime = Timer
Do While i < 95
i = i + 1
Range("DstRng1").Value = Range("SrcRng1").Value
Range("DstRng2").Value = Range("SrcRng2").Value
Range("DstRng3").Value = Range("SrcRng3").Value
Range("DstRng4").Value = Range("SrcRng4").Value
Range("DstRng5").Value = Range("SrcRng5").Value
Loop
SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "The update was successful in " & SecondsElapsed & " seconds", vbInformation
Application.DisplayStatusBar = True
Application.ScreenUpdating = True
End Sub
I want to compare 2 to 1 Columns in Excel using VBA..
I already achieve 2 to 2 Columns using this code
Sub LIST1_LIST2()
Dim list1 As Range
Dim LIST2 As Range
Set list1 = Range("B3:C181")
Set LIST2 = Range("G3:H729")
For Each row1 In list1.Rows
For Each row2 In LIST2.Rows
If (row1.Cells(1) = row2.Cells(1) And row1.Cells(2) = row2.Cells(2)) Then
row1.Cells(1).Offset(0, 2) = row1.Cells(1)
row1.Cells(2).Offset(0, 2) = row1.Cells(2)
Exit For
End If
Next row2
Next row1
End Sub
But now I need something VBA scripts that works somehow like the image below
Work with a a simple Do Until Loop:
Option Explicit
Public Sub Example()
Dim B As Range, _
C As Range, _
D As Range, _
F As Range, _
G As Range
Dim i%, x% ' Dim as long
Set B = Columns(2)
Set C = Columns(3)
Set D = Columns(4)
Set F = Columns(6)
Set G = Columns(7)
i = 2
x = 2
Do Until IsEmpty(B.Cells(i))
Debug.Print B.Cells(i).Value & ", " & _
C.Cells(i).Value ' Print on Immed Win
Do Until IsEmpty(F.Cells(x))
DoEvents ' For testing
If F.Cells(x).Value = B.Cells(i).Value & ", " & _
C.Cells(i).Value Then
Debug.Print F.Cells(i).Value = B.Cells(i).Value & ", " & _
C.Cells(i).Value ' Print on Immed Win
G.Cells(x) = D.Cells(i)
x = 2 ' Reset Loop
Exit Do
End If
x = x + 1
Loop
i = i + 1
Loop
End Sub
Other info
DoEvents is most useful for simple things like allowing a user to cancel a process after it has started, for example a search for a file. For long-running processes, yielding the processor is better accomplished by using a Timer or delegating the task to an ActiveX EXE component.. In the latter case, the task can continue completely independent of your application, and the operating system takes case of multitasking and time slicing.
Debug.Print Immediate Window is used to debug and evaluate expressions, execute statements, print variable values, and so forth. It allows you to enter expressions to be evaluated or executed by the development language during debugging. To display the Immediate window, open a project for editing, then choose Windows from the Debug menu and select Immediate, or press CTRL+ALT+I.
You can use this pseudocode to guide you:
If LASTNAME = Left(NAME,LASTNAME.Length) And _
FIRSTNAME = Right(NAME,FIRSTNAME.Length) Then
I am using excel macro to validate data fields in a table. The data contains some fields that can contain one of the values listed in the dictionary.
When I tried to run the validation macro for 700,000 records, it literally gets stuck and takes a long time to complete. Can anyone help with improving the performance of this code?
The following is a sample code I am using for one of the fields to check the content of cells in a column against a list defined in the dictionary. This never completes when run over 700,000 column records, whereas takes around 30 seconds for 50,000 column records.
Sub Validate_Action_Type()
'Speed Up
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
'Speed Up end
'Define the variables
Dim DicActionType As New Scripting.Dictionary
Dim CountActionTypeErrors As Long
Dim StartTime As Double
Dim SecondsElapsed As Double
'Start the timer, used to calculate elapsed time
StartTime = Timer
'Create a dictionary of allowed marker type values
DicActionType.Add "Insert", 1
DicActionType.Add "Update", 2
DicActionType.Add "Delete", 3
'Check the Marker Type Column using the dictionery created
For Each d2 In Range(Range("C2"), Range("C2").End(xlDown))
If Not DicActionType.Exists(d2.Text) Then
d2.Interior.ColorIndex = 3
CountActionTypeErrors = CountActionTypeErrors + 1
Else
d2.Interior.ColorIndex = xlNone
End If
Next
'Calculate elapsed time
SecondsElapsed = Round(Timer - StartTime, 2)
'Pop-up the outcome message
MsgBox "Time taken in Seconds = " & SecondsElapsed _
& vbCrLf _
& "Total Errors = " & CountActionTypeErrors _
, , "Check Cells Highlighted RED"
'Restore state: undo the speed up settings
Application.ScreenUpdating = ScreenUpdateState
Application.DisplayStatusBar = statusBarState
Application.Calculation = calcState
Application.EnableEvents = eventsState
ActiveSheet.DisplayPageBreaks = displayPageBreaksState 'note this is a sheet-level setting
End Sub
Referencing cells is always very slow. As you want to color your cells, you need a reference, but only for coloring, not for checking. For checking you can use a much faster array.
In the following code I used an array to check the actions. On my machine its about 5 times faster having ~17% errors in my sample cells.
Sub Validate_Action_Type()
'Speed Up
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
'Speed Up end
'Define the variables
Dim DicActionType As New Scripting.Dictionary
Dim CountActionTypeErrors As Long
Dim StartTime As Double
Dim SecondsElapsed As Double
Dim ActionArr, I As Integer
ActionArr = Range(Range("D2"), Range("C2").End(xlDown)).Value
'Start the timer, used to calculate elapsed time
StartTime = Timer
'Create a dictionary of allowed marker type values
DicActionType.Add "Insert", 1
DicActionType.Add "Update", 2
DicActionType.Add "Delete", 3
'Check the Marker Type Column using the dictionery created
Columns("C").Interior.ColorIndex = xlNone
For I = 1 To UBound(ActionArr)
If Not DicActionType.Exists(ActionArr(I, 1)) Then
'ActionArr(I, 2) = 3
Cells(I + 1, 3).Interior.ColorIndex = 3
CountActionTypeErrors = CountActionTypeErrors + 1
Else
ActionArr(I, 2) = 0
End If
Next I
'Calculate elapsed time
SecondsElapsed = Round(Timer - StartTime, 2)
'Pop-up the outcome message
MsgBox "Time taken in Seconds = " & SecondsElapsed _
& vbCrLf _
& "Total Errors = " & CountActionTypeErrors _
, , "Check Cells Highlighted RED"
'Restore state: undo the speed up settings
Application.ScreenUpdating = ScreenUpdateState
Application.DisplayStatusBar = statusBarState
Application.Calculation = calcState
Application.EnableEvents = eventsState
ActiveSheet.DisplayPageBreaks = displayPageBreaksState 'note this is a sheet-level setting
End Sub
As promised I have investigated what the time is going on my laptop. Without knowing which statements are the slowest, you can easily spend your time optimising sections of your code that have little effect on the duration. There is a lot of bad advice available based on people assumptions about what is slow. Application.ScreenUpdating = False will save very significant amounts of time. Other changes are often of little significance. It appears there is some significant overhead with calling WorksheetFunction from VBA because I have yet to find one that is faster than VBA. Unless someone says “I have run timings”, don’t believe them.
I will explain my implementation of your code and then tell you what I discovered. You will need to concatenate the blocks of code below if you wish to perform similar tests on your computer.
Option Explicit
Const ColCrnt As Long = 3
Const NumNames As Long = 30
Const RowDataFirst As Long = 2
Const RowMax As Long = 700000
Const ErrorMax As Long = 70000
I have used constants to specify values I might wish to vary between test runs.
I never changed ColCrnt from 3 (= C) or RowDataFirst from 2 since I do not believe their values are relevant.
I tried much lower values for RowMax and ErrorMax at first but most of my timings were with the values shown. My tests were with 10% errors. I am sure your data is much better so my timings for worksheet updates should be much worse than yours.
I have called the values you place in a dictionary, “names” or “valid names” so NumNamesis the constant I have changed the most.
Sub CtrlCheckAll()
Call CtrlCheck1
Call CtrlCheck1
Call CtrlCheck1
End Sub
I created three variations of your code. This routine allowed me to call all three in one go. It became clear that variations 2 and 3 were not significantly faster or slower than variation 1. In the end, I just used this routine to call variation 1 three times.
When you look at the timings, you will see how much variation there is from run to run. Most of this variation is probably background processes (task manager, virus checkers and the like). However, Excel also has background tasks (such as garbage collection). I prefer much longer test runs because they give more stable timings. Apart from increasing the number of rows, I am not sure how to slow your routine down; I have settled for running it several times and averaging their separate durations.
Sub CtrlCheck1()
Dim CountActionTypeErrors As Long
Dim d2 As Variant
Dim ExistsCrnt As Boolean
‘Dim InxVn As Long
Dim ValidNames As New Dictionary
Dim TimeCheckStart As Single
Dim TimeExistsTotal As Single
Dim TimeStart As Single
Dim TimeWshtTotal As Single
Dim Wsht As Worksheet
Set Wsht = Worksheets("Data")
TimeStart = Timer
Call GenDic(ValidNames, NumNames)
Debug.Print "Create time " & Format(Timer - TimeStart, "00.00000")
'TimeStart = Timer
'For InxVn = 0 To ValidNames.Count - 1
' Debug.Print ValidNames.Keys(InxVn)
'Next
'Debug.Print "Access time " & Format(Timer - TimeStart, "00.00000")
TimeStart = Timer
Call GenWsht(Wsht:=Wsht, RowDataFirst:=RowDataFirst, ColCrnt:=ColCrnt, _
RowMax:=RowMax + RowDataFirst - 1, _
ErrorMax:=ErrorMax, Dic:=ValidNames)
Debug.Print "Build worksheet time " & Format(Timer - TimeStart, "00.000")
Application.ScreenUpdating = False
TimeExistsTotal = 0!
TimeWshtTotal = 0!
TimeCheckStart = Timer
You will recognise some of the variables while others have been introduced by me.
Your code accesses the active worksheet. This relies on the user having the correct worksheet active when the macro is started. You would not do this if you had ever had to fix the mess caused by a user running a macro against the wrong worksheet and not having a backup of the undamaged worksheet. Being explicit about the worksheet to be accessed makes your code clearer, reduces the opportunities for disaster and has no noticeable time penalty.
I have not given you the code for GenDic since you have your own real data. However, I will add the code if you want it. Notice, I have placed Timer around this call. I wanted to know if creating a dictionary was slow process. I discovered the duration was less than Timer can accurately record. Normally the duration was given as zero thousandths of a second although occasionally it was four thousandths of a second
I have commented out the code to list the keys in the dictionary because it was creating too many lines. Again my motive was to see if accessing keys was slow but again the duration was less than Timer can accurately record.
I have not given you the code for GenWsht since you have your own real data. Again, I will add the code if you want it.
The last three statements of the above block are the important ones. TimeCheckStart is used to calculate the total duration of the main block of code. TimeExistsTotal and TimeWshtTotalare used to accumulate the duration of the two statements of thought might be the most expensive in terms of time. I will explain them later.
With Wsht
For Each d2 In Range(.Cells(RowDataFirst, ColCrnt), _
.Cells(RowDataFirst, ColCrnt).End(xlDown))
TimeStart = Timer
ExistsCrnt = ValidNames.Exists(d2.Text)
TimeExistsTotal = TimeExistsTotal + Timer - TimeStart
If Not ExistsCrnt Then
TimeStart = Timer
d2.Interior.ColorIndex = 3
TimeWshtTotal = TimeWshtTotal + Timer - TimeStart
CountActionTypeErrors = CountActionTypeErrors + 1
End If
Next
End With
This is a slightly modified version of the critical part of your code. As explained earlier, I access cells in a named worksheet. I do not believe this could have a noticeable
I have split the test for a name existing out of the If statement so I can place Timer statements around the test. This probably has a minor effect on the duration but you cannot add timer statements without having an effect. Note that what these Timer statements are doing is accumulating the total duration of these tests. I have also places Timer statements around d2.Interior.ColorIndex = 3
Debug.Print "##### Check 1 #####"
Debug.Print " Number rows " & RowMax
Debug.Print " Number errors " & ErrorMax
Debug.Print " Valid names " & ValidNames.Count
Debug.Print " Total check time " & Format(Timer - TimeCheckStart, "00.000")
Debug.Print "Total exists time " & Format(TimeExistsTotal, "00.000")
Debug.Print " Total wsht time " & Format(TimeWshtTotal, "00.000")
End Sub
This is the final block of variation 1 of my code.
Two of my timings were:
Total check time 12.766 9.820
Total exists time 10.031 7.852
Total wsht time 2.152 1.543
The first issue to notice is the difference between the two sets of figures with the first run taking 33% more time than the second. This is typical of the variation you will get in the duration of short runs.
The second issue is that the total duration of the two timed statements is around .6 seconds less that the total duration. This is to be expected since all the other statement take some time; there is no expensive statement yet to find. Since your durations are so much longer than mine, you need to review your timings and perhaps test other statements if your unexplained duration is excessive.
The last issue is that the total duration of the worksheet update is so much less that the existence check. Since 10% of my data is faulty which I assume far exceeds your error rate, your worksheet update time should be much, much less than mine. Optimising the worksheet update would have minimal effect on the total duration.
With variation 2, the inner code is:
RowLast = .Cells(Rows.Count, ColCrnt).End(xlUp).Row
For RowCrnt = RowDataFirst To RowLast
TimeStart = Timer
ExistsCrnt = ValidNames.Exists(.Cells(RowCrnt, ColCrnt).Text)
TimeExistsTotal = TimeExistsTotal + Timer - TimeStart
If Not ExistsCrnt Then
TimeStart = Timer
.Cells(RowCrnt, ColCrnt).Interior.ColorIndex = 3
TimeWshtTotal = TimeWshtTotal + Timer - TimeStart
CountActionTypeErrors = CountActionTypeErrors + 1
End If
Next
Here I have used a For Loop instead of a For Each Loop. It is not clear from my timings which is faster. I will not bother to test further. I would use whichever I found more convenient even if I knew one was fractionally faster than the other.
For variation 3, I introduced a With statement for the cell:
With Wsht
RowLast = .Cells(Rows.Count, ColCrnt).End(xlUp).Row
For RowCrnt = RowDataFirst To RowLast
With .Cells(RowCrnt, ColCrnt)
TimeStart = Timer
ExistsCrnt = ValidNames.Exists(.Text)
TimeExistsTotal = TimeExistsTotal + Timer - TimeStart
If Not ExistsCrnt Then
TimeStart = Timer
.Interior.ColorIndex = 3
TimeWshtTotal = TimeWshtTotal + Timer - TimeStart
CountActionTypeErrors = CountActionTypeErrors + 1
End If
End With
Next
End With
This does look to be faster than variation 2, as expected, and perhaps a little faster than variation 1 but the evidence for these conclusions is poor.
Here are the timings:
In the bold lines, the timings are averages of the individual run times shown below.
The big reveal from this is that the size of the dictionary has no effect on run time.
My investigation has revealed nothing that would help you. I have explained how I created my timings and how I interpreted those timings so you can test what is different about your system.
Is it possible to write an infinite for loop in VB.NET?
If so, what is the syntax?
Do
Something
Loop
For i as Integer = 0 To 1 Step 0
If that's not hacky enough, can also write:
For i As Integer = 0 To 2
i -= 1
Next
or
while (true)
end while
ok, proper For answer:
Dim InfiniteLoop as Boolean = true;
For i = 1 to 45687894
If i = 45687893 And InfiniteLoop = true Then i = 1
End For
Aside from all the many answers given to make a loop run forever, this may just be the first that actually uses the value of Positive Infinity to cap the loop. Just to be safe though, I included an extra option to exit after a given number of seconds so it can measure the speed of your loop.
Sub RunInfinateForLoop(maxSeconds As Integer)
' Attempts to run a For loop to infinity but also exits if maxSeconds seconds have elapsed.
Dim t As Date = Now
Dim exitTime As Date = t.AddSeconds(maxSeconds)
Dim dCounter As Double
Dim strMessage As String
For dCounter = 1 To Double.PositiveInfinity
If Now >= exitTime Then Exit For
Next
strMessage = "Loop ended after " & dCounter.ToString & " loops in " & maxSeconds & " seconds." & vbCrLf &
"Average speed is " & CStr(dCounter / maxSeconds) & " loops per second."
MsgBox(strMessage, MsgBoxStyle.OkOnly, "Infinity Timer")
End Sub
What I do is add a timer then I change the interval to 1 and then I make it enabled then If I want it to constantly check something through the loop I just double click the timer for the timer_tick event then I type what I want. I usually use this for updating the settings if I want it to save every thing.