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

 

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.
Raymond Mills, M.B.A., M.S.  has spent over 20 years of his career as Accountant, Investment Bank and Credit Card Technical Auditor/ Data Analyst.  His specialty was using Excel to get Big Databases including Teradata, Oracle,  Squel Server and Sybase to give up their secrets. Ray has said “I love nothing better than using VBA to unleash the power of Microsoft Office.” You can contact Ray @ 484 574-3190 or by emailing him Here

If you have a challenge with Excel, Access or Word and would like to speak with Ray,   You can get his contact details by clicking here: Contact Me