I have a simple SUB within an Excel VBA module that runs almost instantly and gives control back to the user with no noticeable delay - but only when I run the sub from Excel's Alt-F8 list of public subs.
When I run the same sub by launching it from a button or shape then it still runs almost instantly BUT on finishing takes about 3 seconds to give control back to the user. The Windows busy circle icon displays on the screen during this pause and Excel does not respond to any key presses.
So, why can launchng a sub from a button be so different to launching from Alt-F8?
(I know that the sub itself runs very quickly as I have tested it with a Timer wrapper which confirms that the actual code runs in less than 0.1 seconds)
The code is shown here, but I would've thought this almost irrelevant as the same code is being run but just being launched by different means.
Public Sub RefDel()
IX = ActiveCell.Row: IY = ActiveCell.Column
If Cells(IX, 2) = "R" And (IY = PlnNor Or IY = PlnRef) Then
II = MsgBox("Remove Reference?", 292, Cells(IX, PlnRef))
If II = vbYes Then
ProtOff
NOF = Cells(IX, PlnNor)
Rows(IX & ":" & IX + NRoRef - 1).Delete Shift:=xlUp
Do While Cells(IX, 2) = "R" ' Renumber subsequent rows
Cells(IX, PlnNor) = NOF
NOF = NOF + 1
IX = IX + NRoRef
Loop
Cells(IX - NRoRef, PlnRef).Select
ProtOn
End If
Else
MsgBox "Select a Reference", vbCritical, "Delete Reference"
End If
End Sub
Related
This is what my sheet looks like:
(I got the code from online somewhere & just been adjust what I know)
I Currently have 10 rows with working buttons, but it's already at 500+ lines of code and I still need 60more. I'm worried the file will become too large and start crashing.
Should I just keep changing the "Range(F#)" every time I make a new button/row?
Also, is it possible to keep more than 1 timer going at a time? Currently when I click stop on any of the rows it will stop whatever timer is active.
Public StopIt As Boolean
Public ResetIt As Boolean
Public LastTime
Private Sub cust10reset_Click()
Range("F10").Value = Format(0, "00") & ":" & Format(0, "00") & ":" & Format(0, "00") & "." & Format(0, "00")
LastTime = 0
ResetIt = True
End Sub
Private Sub cust10start_Click()
Dim StartTime, FinishTime, TotalTime, PauseTime
StopIt = False
ResetIt = False
If Range("F10") = 0 Then
StartTime = Timer
PauseTime = 0
LastTime = 0
Else
StartTime = 0
PauseTime = Timer
End If
StartIt:
DoEvents
If StopIt = True Then
LastTime = TotalTime
Exit Sub
Else
FinishTime = Timer
TotalTime = FinishTime - StartTime + LastTime - PauseTime
TTime = TotalTime * 100
HM = TTime Mod 100
TTime = TTime \ 100
hh = TTime \ 3600
TTime = TTime Mod 3600
MM = TTime \ 60
SS = TTime Mod 60
Range("F10").Value = Format(hh, "00") & ":" & Format(MM, "00") & ":" & Format(SS, "00") & "." & Format(HM, "00")
If ResetIt = True Then
Range("F10") = Format(0, "00") & ":" & Format(0, "00") & ":" & Format(0, "00") & "." & Format(0, "00")
LastTime = 0
PauseTime = 0
End
End If
GoTo StartIt
End If
End Sub
Private Sub cust10stop_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
StopIt = True
End Sub
I tried making a dedicated formula tab and just make macros going my timer buttons but I couldn't get that to work.
I tried making a togglebutton and linking it to the cell then just make a code that references the linkedcell to know where to put the timer, but that wasn't working. It just kept coming back true/false.
I guess I just want to know if it's ok to have 4000+ lines on 1 sheet with 210 buttons lol.
Or just an easier way.
Here's one approach using hyperlinks in place of buttons:
The hyperlinks you create need to have a destination, but in this case we want "do nothing" links - their only purpose is to trigger the sheet's FollowHyperlink event
This post
excel hyperlink to nothing
has suggestion for approaches to a "do nothing" hyperlink. Entering #rc for the address seems to work well - as explained by lori_m in their comment -
The # signifies a reference within a document and any formula that
returns a reference can follow in either A1 or r1c1 notation. Here rc
means this cell in r1c1notation.
Set up some links using "Insert >> Hyperlink", using "#rc" as the link target (entered next to "Address").
Don't use the HYPERLINK() formula, because those types of links don't trigger the FollowHyperlink event.
For example (3 timers running):
Finally this code goes in the worksheet code module:
Option Explicit
Dim timers As Object 'cell addresses as keys and start times as values
Dim nextTime 'next run time
'This is called when youclickon a hyperlink
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim txt As String, cLnk As Range, cTimer As Range, addr As String
Dim currVal
If timers Is Nothing Then Set timers = CreateObject("scripting.dictionary")
Set cLnk = Target.Range 'cell with clicked link
Set cTimer = cLnk.EntireRow.Columns("B") 'cell with elapsed time
addr = cTimer.Address(False, False) 'address of cell with elapsed time
txt = Target.TextToDisplay 'Start/Stop/Reset
Select Case txt 'what action to take depends on the link's text
Case "Stop"
If timers.Exists(addr) Then timers.Remove addr
Target.TextToDisplay = "Start" 'toggle link text
cLnk.Interior.Color = vbGreen 'toggle cell color
Case "Start"
currVal = cTimer.Value 'already some elapsed value?
timers(addr) = IIf(Len(currVal) > 0, Now - currVal, Now)
Target.TextToDisplay = "Stop"
cLnk.Interior.Color = vbRed
Case "Reset"
If timers.Exists(addr) Then 'timer is running?
timers(addr) = Now 'just reset the start time
Else
cTimer.Value = 0 'clear the elapsed time
End If
End Select
UpdateTimers
End Sub
'called using OnTime, or from the event handler
Sub UpdateTimers()
Dim addr As String, k, macro
macro = Me.CodeName & ".UpdateTimers"
On Error Resume Next 'cancel any running timer
Application.OnTime EarliestTime:=nextTime, Procedure:=macro, Schedule:=False
On Error GoTo 0
If timers.Count = 0 Then Exit Sub 'no more timers
For Each k In timers 'update timer(s)
Me.Range(k).Value = Format(Now - timers(k), "hh:mm:ss")
Next k
nextTime = Now + TimeSerial(0, 0, 1) 'schedule next run
Application.OnTime nextTime, macro
End Sub
What you could consider is to work with a Class module and a dictionary.
The Timer() command in XL merely generates a TimeStamp value that you can store for later use. You could do that in a dictionary with a particular class.
Create a Class module and name it cTimer add below code
Option Explicit
Private pTimer As Single
Public Sub StartTimer()
pTimer = Timer()
End Sub
Property Get Elapsed() As Single
Elapsed = Timer() - pTimer
End Property
Now, mind you, the portion of using the class may not strictly be required as you could simply add a dictionary entry for the address and Timer() value.
like so:
dict.Add Key, Timer()
But working with a class object allows you to create more functionality for each of the cTimer objects.
Now, to keep track of all the timers you can set add a new cTimer object to the dictionary based on the cell address of the button (this may need some fine tuning to ensure all your buttons eventually generate the same reference key)
But that is the most important portion of it, the reference key.
In a code module, add the below, this will look for an existing entry in the dictionary and if it exists display the elapsed time otherwise a new cTimer object will be added to the dictionary with the address as the reference key.
Create a Module and add the following:
Global dict As Object 'this line should be all the way at the top of the module code!
Sub TestTimer()
Dim rngButton As Range
Dim mm As cTimer
If dict Is Nothing Then
Set dict = CreateObject("Scripting.Dictionary")
End If
Caller = Application.Caller
Set rngButton = ActiveSheet.Buttons(Caller).TopLeftCell
Key = rngButton.Address
Set tmr = New cTimer
tmr.StartTimer
If Not dict.Exists(Key) Then
dict.Add Key, tmr
Else
Set tmr = dict(Key)
Debug.Print tmr.Elapsed
End If
End Sub
This may obviously need some tweaking to suit your particular need, but this could well be the solution you aim for. As you can simply have all the buttons refer to the same Method (or Macro)
You should add some logic for removing times and for resetting them etc. but the concept works.
see also: https://learn.microsoft.com/en-us/office/vba/Language/Reference/User-Interface-Help/dictionary-object
I have a heavy model calculating c.310 financial data for c.12.000 companies. The initial data is retrieved from the S&P Capital IQ online database through an Excel add-in which requires calculation to be on semi-automatic or automatic mode to update.
Multithread calculation to update all formulae at once makes the model crash and up to this point I can only update it by taking each column individually and manually update them (and then copy/paste values) without macro to have the multithreading computation.
To automate the process, I created a macro that takes each of the 310 columns individually, copy/pastes the formula for all companies, calculates the selection only and then pastes in values before proceeding to the next column.
But VBA being in singlethread calculation and the add-in requiring calculation mode to be in semi-automatic, the macro still takes over 8h to update the whole model as for each column update, the macro has to update the whole sheet everytime.
For the update to go faster, I would need either a way to allow VBA multithreading (but seems complex to do), or to find a way to have Calculation Mode on Automatic for only one column at a time, so that VBA does not update the whole worksheet everytime.
Do you have any idea if this would be possible and how ?
Thank you very much for your help!
Here is the structure of the current VBA code (one section out of 8) :
My sincere apologies if this code is far from optimised, I am self taught in VBA.
All named ranges below are mostly meant to identify a column/row number that can change depending on how many companies I want to analyse.
FONDA is the Excel worksheet.
Sub Update()
'==============================================================
'INITIALISATION
Dim FirstRow As Integer, LastRow As Integer, i As Integer, Errors
As Integer
Dim Progress As Double, ProgressPercentage As Double, BarWidth As
Long, Steps As Integer, CurrentProgress As Double
Dim StartTime As Double, MinutesElapsed As String
StartTime = Timer
Steps = 312
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.CalculateBeforeSave = False
Call InitProgressBar
FONDA.Select
Range("FONDA_FIRSTROW").Calculate
FirstRow = Range("FONDA_FIRSTROW").Value
Range("FONDA_LASTROW").Calculate
LastRow = Range("FONDA_LASTROW").Value
Range("FONDA_UPDATECHECK").ClearContents
Range(Cells(Range("FONDA_FIRSTROW").Value,
Range("Section_A_D").Column), Cells(Range("FONDA_LASTROW").Value,
Range("Section_B_F").Column)).ClearContents
CurrentProgress = Progress / Steps
ProgressPercentage = Round(CurrentProgress * 100, 1)
BarWidth = ProgressIndicator.Border.Width * CurrentProgress
ProgressIndicator.Bar.Width = BarWidth
ProgressIndicator.Text.Caption = "Calculation : " &
ProgressPercentage & "%"
DoEvents
'==============================================================
'SECTION A
'Update from left to right
For i = 1 To Range("Section_A_ColumnCounter").Value
Application.Calculation = xlCalculationManual
Cells(Range("FONDA_FORMULAROW").Value, Range("Section_A_D").Column
+ i - 1).Copy
Range(Cells(Range("FONDA_FIRSTROW").Value,
Range("Section_A_D").Column + i - 1),
Cells(Range("FONDA_LASTROW").Value, Range("Section_A_D").Column + i
- 1)).PasteSpecial Paste:=xlPasteFormulas
Application.Calculation = xlCalculationSemiautomatic
ActiveSheet.Calculate
'Application.Wait (5)
'Do Until Application.CalculationState = xlDone
'DoEvents
'Loop
Application.Calculation = xlCalculationManual
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Cells(Range("FONDA_ERRORCOUNTER").Value,
Range("Section_A_D").Column + i - 1).Calculate
Errors = Cells(Range("FONDA_ERRORCOUNTER").Value,
Range("Section_A_D").Column + i - 1).Value
If Errors = 0 Then
Cells(Range("FONDA_UPDATECHECK").Row,
Range("Section_A_D").Column + i - 1).Value = 1
Progress = Progress + 1
End If
CurrentProgress = Progress / Steps
ProgressPercentage = Round(CurrentProgress * 100, 1)
BarWidth = ProgressIndicator.Border.Width * CurrentProgress
ProgressIndicator.Bar.Width = BarWidth
ProgressIndicator.Text.Caption = "Calculation : " &
ProgressPercentage & "%"
DoEvents
Next i
'==============================================================
'END OF PROCEDURE
Application.CutCopyMode = False
Range("FONDA_UPDATE_ERRORS").Calculate
Range("FONDA_LAST_UPDATE").Select
With Selection
.Value = Now
.NumberFormat = "dd/mm/yyyy h:mm:ss"
End With
Progress = Progress + 1
Application.Calculation = xlCalculationManual
CurrentProgress = Progress / Steps
ProgressPercentage = Round(CurrentProgress * 100, 1)
BarWidth = ProgressIndicator.Border.Width * CurrentProgress
ProgressIndicator.Bar.Width = BarWidth
ProgressIndicator.Text.Caption = "Calculation : " &
ProgressPercentage & "%"
DoEvents
Range(Cells(Range("FONDA_FIRSTROW").Value,
Range("FONDA_FIRSTCOLUMN").Value),
Cells(Range("FONDA_FIRSTROW").Value,
Range("Section_B_F").Column)).Copy
Range(Cells(Range("FONDA_FIRSTROW").Value + 1,
Range("FONDA_FIRSTCOLUMN").Value),
Cells(Range("FONDA_LASTROW").Value,
Range("Section_B_F").Column)).PasteSpecial Paste:=xlPasteFormats
Application.ScreenUpdating = True
MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
Range("FONDA_LAST_UPDATE").Select
Application.CalculateBeforeSave = False
ThisWorkbook.Save
MsgBox "Update completed in " & MinutesElapsed & " minutes",
vbInformation + vbOKOnly, "Information"
Call ExitSub
End Sub
The formulae that are meant to be updated are coming from the S&P Capital IQ add-in and follow this syntax :
= #CIQ ( $F39 ;"IQ_NPPE" ; ; LM$37 ; ; ; CURRENCY )
These data are retrieved from online the S&P Capital IQ database.
As a consequence I do not see what I could optimise on this part.
It is also relevant to mention that all the Excel formulae (that do not use a CIQ formulae within) do compute very fast and are not the root cause of the problem : when I update column by column, only the CIQ ones are slow.
Latest lead :
The S&P Capital IQ add-in has a "Refresh Selection" function. I just realised that clicking on it does indeed refresh the data even in manual calculation mode.
When I record a macro and click on this CIQ "Refresh Selection" function, no code is recorded though.
So now my thought is to find a way to make VBA communicate with the CIQ add-in to trigger this CIQ function "Resfresh Selection" from within the VBA code. This way, it could potentially refresh the data with manual calculation and therefore update much faster.
Do you have any idea how to create a link between VBA and another external add-in function ?
Thank you very much !
I have a VBA code that allows a user to enter in record ID numbers in a system and the code will record pertinent data to a txt file. This code was working flawlessly and one day it stopped working. An error is occurring at the Call mainLookup(GetField(rid, i, ",") portion of the code but I cannot identify and correct the error.
Sub Main()
Set System = CreateObject("XXXXX.System")
If (System Is Nothing) Then
Stop
End If
Set Session = System.ActiveSession
If (Session Is Nothing) Then
Stop
End If
Set Screen = System.ActiveSession.Screen
rid$ = InputBox("Enter RID (no dashes)" + " separate entries with a comma only")
If (Len(rid) Mod 5 <> 7) Then
MsgBox "Incorrectly formatted RID", 16, "ALAS"
End If
Number% = (Len(rid) + 1) / 6
For i = 1 To Number
Call mainLookup(GetField(rid, i, ","))
Next i
Stop
End Sub
I'm trying to learn how to use a progress bar with a userform.
The problem I have, with my code, is that it displays the progress bar after running the loop; it should be running the loop while showing the progress bar instead like 10%...20%...30%...40%......100%.
Can anyone help me fix my code to achieve this?
'-----Below is loop-----------------------------------------------------
Sub looprange()
Dim r As Range
'----------loop thru 0 to 9 ---------------
For Each r In Sheet6.Range("j2", Range("j" & Rows.Count).End(xlUp))
Sheet6.Range("i2").Value = r.Value
ActiveWindow.ScrollRow = 11
Application.CutCopyMode = False
Call print_jpeg
Next r
MsgBox "done"
End Sub
--
'--------Below is vba code in userform :------------
Private Sub UserForm_Activate()
Dim remainder As Long
Dim i As Long, j As Long
Call looprange
remainder = 0
For i = 1 To 200
UserForm1.Label2.Width = UserForm1.Label2.Width + 1
If i Mod 2 = 0 Then
remainder = remainder + 1
UserForm1.Caption = remainder & ” % complete”
UserForm1.Label2.Caption = remainder & “%”
End If
For j = 1 To 600
DoEvents
Next j
Next i
MsgBox “Loading of program complete.”
Unload UserForm1
End Sub
I believe a true status bar is not included in standard VBA (without references), however you can abuse a label control. Be aware that this method trades performance for user clarity (the user can see that the application is working, but it is slower than the same application without the status bar)
Simply add three labels, one for status text, one for the actual moving bar and one for full bar border. And format them to fit your application (see image below):
Code below:
Private Sub cbStart_Click()
one_percent_bar_width = lLoadBar.Width / 100 'width of one percent of the total loading bar
max_numbers = 1000 'only for demo purpose
Me.lLoadingBar.Visible = True
For i = 0 To max_numbers 'your loop here
'your code here
percentage = i / max_numbers * 100 'calculation of progress, replace i and max_numbers to fit your loop
Me.lStatus.Caption = percentage & "% complete" 'status percentage text
Me.lLoadingBar.Width = percentage * one_percent_bar_width 'width of actual blue bar
DoEvents 'slows down code but only way to make the bar visibly move, tradeoff between user clarity and speed
Next i 'edit to fit your loop
Me.lStatus.Caption = "Complete!" 'adjust status to whatever you want
End Sub
Private Sub UserForm_Initialize()
Me.lLoadingBar.Visible = False 'hide the small blue bar
Me.lStatus.Caption = "Progress not started" 'adjust status to whatever you want
End Sub
There are a few issues with your code, but to focus on the Progress Bar part, I'll share an example of one way to handle a progress bar in Excel (using the built-in status bar).
Instead of actually doing anything useful, this example is pausing for a split second between loops, but reports the status on the status bar.) Hopefully it will give you some ideas.
Sub ProgressBarTest()
Const LoopsToRun = 500
Dim z As Integer
For z = 1 To LoopsToRun
'put a random number in A1
Range("A1") = Int(Rnd() * 100) + 1
'update status bar
Application.StatusBar = "Progress: " & Format((z / LoopsToRun), "0.0%")
'pause for .3 seconds (instead of pausing, you'd run your actual procedure here)
Pause (0.1)
Next z
Application.StatusBar = "Complete!"
End Sub
Sub Pause(sec As Single)
'pauses for [sec] second
Dim startTime As Single
startTime = Timer
Do While Timer < startTime + sec
DoEvents
Loop
End Sub
More info here and here.
VBA has a progress bar control that can be added to forms. While you are learning, you can simply add this control to the form and then update that control during the loop where you are doing the useful form functions. The progress bar controls includes useful properties such as min and max.
If you are doing multiple things in your form, you can update a label to tell the user what is progressing as well as the amount of progress.
[More advanced] In some of my previous work, I have set up VBA routines to run in the background and created a progress bar form using events. This allows for a more sophisticated view with progress statements as well as a percentage run. But the basis of this form is still the progress bar control. While using events is more complicated it allowed me to make a more general progress bar form that can be used by any of my vba functions and these functions are then unaffected by any changes I make to the form because the events act as a kind of standard interface.
Update from a comment by #MathieuGuindon: "The control is actually a VB6 control and will only work in a 32-bit VBA host with the .OCX properly registered, which is getting more and more challenging to do with the more recent Windows versions; referencing and using these controls in VBA7 is heavily discouraged."
I am disabling a button onclick, but it is still allowing the click.
Code is like below:
UsrForm.Field1.Value = ""
UsrForm.Field2.Value = ""
UsrForm.btn.Enabled = False
UsrForm.Repaint
/*Processing Occurs*/
UsrForm.Field1.Value = val1
UsrForm.Field2.Value = val2
UsrForm.btn.Enabled = True
However, if I double click or click a few times where the disabled button is, it still runs the method several times, despite being disabled.
I think we have a proper bug here. The solution posted by S Meaden does not work (at least, not in my testing). Here's what I trew together for testing:
Private Sub CommandButton1_Click()
Dim w As Date
Me.CommandButton1.Enabled = False
w = Now + TimeSerial(0, 0, 2)
Debug.Print "point 1: " & Now
Application.Wait w
Debug.Print "point 2: " & Now
Me.CommandButton1.Enabled = True
End Sub
Clicking it makes it gray out (as it should when disabling) and run the routine. Clicking twice however runs the routine twice. Because it prints the times, it is clear that the routines run in sequence, so it seams that excel (in my case excel, haven't tested with other applications) remembers the clicks, and when the routine finishes (and the button is enabled again) the routine is called. It runs 3 or 4 times in a row as well.
Because of this, implementing S Meaden's answer, like so:
Dim clicked as Boolean
Private Sub CommandButton1_Click()
Dim w As Date
If Not clicked Then
clicked = True
Me.CommandButton1.Enabled = False
w = Now + TimeSerial(0, 0, 2)
Debug.Print Now
Application.Wait w
Debug.Print "punt 2 (" & Now & ")"
Me.CommandButton1.Enabled = True
clicked = False
End If
End Sub
does not work either.
It seems that if the button is enabled after the routine is finished, the clicks that were placed during routine execution are discarded. So as a workaround, you could use:
Private Sub CommandButton1_Click()
Dim w As Date
Me.CommandButton1.Enabled = False
w = Now + TimeSerial(0, 0, 2)
Debug.Print "point 1: " & Now
Application.Wait w
Debug.Print "point 2: " & Now
Me.Button1_clicked = False
Application.OnTime (Now + 0.000001), "enable_commandbutton"
End Sub
with "enable_commandbutton" being:
Public Sub enable_commandbutton()
Dim uf As Object
Debug.Print "check"
For Each uf In VBA.UserForms
If uf.Name = "UserForm1" Then
uf.CommandButton1.Enabled = True
End If
Next uf
End Sub
in a normal codemodule.
It is not pretty, but it works.
That's interesting. I agree your code should work and I am puzzled by that. However, I'm the sort of guy who would code around and so here is some that uses a module level variable to keep note of whether the procedure is already running.
Option Explicit
Private mbAlreadyProcessing As Boolean
Private Sub btn_Click()
On Error GoTo ErrHandler
If Not mbAlreadyProcessing Then
mbAlreadyProcessing = True
'do some work
mbAlreadyProcessing = False
End If
Exit Sub
ErrHandler:
'here we remember to "re-enable"
mbAlreadyProcessing = False
'do some error handling
End Sub