You have just spent the last three days perfecting a killer dashboard for Maximum Trucking Inc. It reaches out to 8 different site data sources. The graphics are spot on and identify trends and emerging issues. You run it again to test the final version and realize it takes over two Minutes to run. No, it is not bad coding but, connecting to those 8 data sites is not instantaneous. It strikes you that two minutes is an eternity to today’s user.
The question then becomes what do you do? The answer lies in a bit of magician’s trick referred to as misdirection. We can not make our app process any faster but, what we can do is divert the users attention. We can do this by creating and displaying a Custom Excel Status Form
This simple Status for contains 3 controls:
1. a label named lblStatus
2. a frame named Outer
3. A framed named inner with the BackColor set to Red
1. a label named lblStatus
2. a frame named Outer
3. A framed named inner with the BackColor set to Red
When the user runs the app (Macro) the status form appears and lets the user know exactly where they are in the process.
I have included the demo code below.
| 1 | Sub DemoStatusForm() |
| 2 | |
| 3 | '******************************************** |
| 4 | '** Date: 08/24/2020 |
| 5 | '** Developer: Ray Mills |
| 6 | '** www.ExcelandVBACraftsman.com |
| 7 | '** (484) 574-3190 |
| 8 | '** Purpose: Demonstrate a Status form |
| 9 | '** |
| 10 | '******************************************** |
| 11 | ' declare variables ... |
| 12 | Dim sMisc As String |
| 13 | Dim dtStart As Date |
| 14 | Dim i As Integer, y As Integer, x As Integer |
| 15 | |
| 16 | 'set the start time |
| 17 | dtStart = Now |
| 18 | |
| 19 | ' load the form ... |
| 20 | Load frmStatus |
| 21 | With frmStatus |
| 22 | .frOuter.Caption = "0% Complete" |
| 23 | .frInner.Width = 0 |
| 24 | .Show |
| 25 | .Repaint |
| 26 | End With |
| 27 | |
| 28 | 'this section simulates where we are reaching out getting the data ... |
| 29 | For x = 1 To 8 |
| 30 | 'Wait for 10 seconds |
| 31 | Application.Wait Now + TimeValue("0:00:10") |
| 32 | |
| 33 | 'Update the form ... |
| 34 | With frmStatus |
| 35 | .lblStatus.Caption = "Daily Delivery Import " & x & " of 8 Sites completed" |
| 36 | |
| 37 | If x > 2 Then |
| 38 | i = DateDiff("s", dtStart, Now) / x |
| 39 | If (i * (8 - x)) < 60 Then |
| 40 | i = (i * (8 - x)) |
| 41 | sMisc = "Anticipated completion in 0 minutes and " & i & " seconds." |
| 42 | Else |
| 43 | i = (i * (8 - x)): y = Round(i / 60) |
| 44 | i = i - (y * 60) |
| 45 | sMisc = "Anticipated completion in " & y & " minutes and " & i & " seconds." |
| 46 | End If |
| 47 | |
| 48 | .lblStatus.Caption = .lblStatus & vbNewLine & sMisc |
| 49 | End If |
| 50 | |
| 51 | .frOuter.Caption = Format(x / 8, "0.0%") |
| 52 | .frInner.Width = (200 * (x / 8)) |
| 53 | .Show |
| 54 | .Repaint |
| 55 | End With |
| 56 | Next x |
| 57 | |
| 58 | Unload frmStatus |
| 59 | |
| 60 | End Sub |
Code Snippets by Ray Mills
This is my solution - Always thoroughly test and retest your code
I have added a tiny bit of math to calculate the minutes and seconds left. Just walk through it and you will see its nothing difficult.
If you enjoyed my blog and would like to comment or share a similar experience please send your comments Here.
If you would like to say hello and Buy me a cup of coffee please follow the link.
If you enjoyed my blog and would like to comment or share a similar experience please send your comments Here.
If you would like to say hello and Buy me a cup of coffee please follow the link.
