Scrolling label text

[MartinS]

Hi
So I have been working on an application for some time, and we are getting close to having a fully working version. One minor issue I have is with the way the user sees what is happening. The logic required is that the user doesn't have to sit there and not know where abouts the code is - he may want to run it for many records and multiple scenarios so it can take anything from a minute or so up to 10 minutes, maybe more. This way, the user gets to see the events as they run using text that makes sense as each procedure is called. So here is how I've set this up:

I've added a userform (225 high by 337.5 wide) with three label controls, lblStatus1 (18 high by 322 wide), lblStatus2 (150 high by 322 wide) and lblStatus3 (12 high by 322 wide). The first and third are standard labels which sit above and below the second (top for 1 is 6, 2 is 30 and 3 is 186).

The second label (lblStatus2) has a white background, and a single border, with an opaque backstyle.

Here is the userform's activate event:

Private Sub UserForm_Activate()
Dim sSub As String: sSub = sSubName
Dim sArg As String: sArg = ""
Dim iPos As Integer
iPos = InStr(1, sSubName, ";")
If iPos > 0 Then
    sSub = Left(sSubName, iPos - 1)
    sArg = Mid(sSubName, iPos + 1)
If sArg = "" Then
    Application.Run sSub
Else
    Application.Run sSub, sArg
End If
Me.Repaint
Application.Wait Now + TimeValue("00:00:01")
sSubName = ""
Me.Hide
End Sub

The form also has a public property:

Public sSubName As String

When a ribbon button is clicked, it runs a procedure to load and initialise the userform:

Call RunWithUserInfo("RunMyEvents", "My App Name", "Ribbon Button 1")

The code behind this is as follows:

Sub RunWithUserInfo(SubName As String, FormCaption As String, Optional DefaultMsgText1 As String = "", Optional DefaultMsgText2 As String = "", Optional DefaultMsgText3 As String = "")
Load xlt_frmUserInfo
With xlt_frmUserInfo
    .Caption = FormCaption
    .Controls("lblStatus1").Caption = DefaultMsgText1
    .Controls("lblStatus2").Caption = DefaultMsgText2
    .Controls("lblStatus3").Caption = DefaultMsgText3
    .sSubName = SubName
    .Show
    .Repaint
End With
End Sub

As you can see, this loads the form and sets the text for the first label, adds the title and stores the procedure name into the property.

Then, before each subsequent event that is run within the overall procedure (RunMyEvents), another call is made, e.g.:

Call UpdateUserInfoStatus(2, "Running the initialisation...")
Call EventName1
Call UpdateUserInfoStatus(2, "Loading the data...")
Call EventName2
...
Call UpdateUserInfoStatus(2, "Tidying up...")
Call EventName25

Here is the procedure code:

Sub UpdateUserInfoStatus(iLabel As Integer, Message As String)
With xlt_frmUserInfo
    If .Controls("lblStatus" & Format(iLabel, "0")).Caption = "" Or iLabel = 3 Then
        .Controls("lblStatus" & Format(iLabel, "0")).Caption = Message
    Else
        .Controls("lblStatus" & Format(iLabel, "0")).Caption = .Controls("lblStatus" & Format(iLabel, "0")).Caption & vbCrLf & Message
    End If
    .Repaint
End With
End Sub

This code writes the text to the specific label (usually 2, label 3 is redundant for the moment) and if blank, it simply adds the text, but if there is already text, i.e. several procedures have already been run, then it appends it to the end.

The issue I have is that we are running many procedures as it loops through several iterations, and once the text in lblStatus2 gets longer than 15 lines, you can't see the progress. I tried switching to a ListBox, but that just added a scrollbar, when what I'd like is the top one to be removed each time a new one is added so you only ever see, say in this example, 15 lines.
I can't figure out how to add the lines, and then remove the top one each time! Or is there an easier/smarter way to do this?
Any help or advice gratefully received.
Many thanks
Martin

 

[Snakehips]

Martin,

I've tested this successfully with a single label. Hopefully I have done nothing careless in tweaking it to take the iLabel variable and work on any of the three Labels.

There are notes in the code.
It hinges on keeping a count of the number of messages passed.
I have tested using e.g. spare sheet cells .... Sheet2 A1:A3 Change these if not an option for you.
Alternatively you may wish to count using Global variables or a hidden object in the form?

NB the code does not reset the counter.
The counter needs to be reset to zero at some point e.g. when form initialised or form closed or whatever. I will leave that up to you.
To start with if you test it using the existing sheet cells as the counter you can just clear the cells prior to opening the form.

Sub UpdateUserInfoStatus(iLabel As Integer, Message As String)
Dim Mssgs As Variant


'**********************************
'A1 and ofsets 1 & 2.... these cells used as counters to check number of messages
'Could substitute Global variables or hidden text boxes on the form
'Anything that can accumulate the count and be interrogated


With Sheets("Sheet2").Range("A1").Offset(iLabel - 1, 0)
    .Value = .Value + 1
        If .Value > 14 Then   ' 14 = one less than max visible messages
            Mssgs = Split(xlt_frmUserInfo.Controls("lblStatus" & Format(iLabel, "0")).Caption, vbCrLf)
            x = UBound(Mssgs) - 1
                For i = 0 To UBound(Mssgs) - 1
                    Mssgs(i) = Mssgs(i + 1)
                Next i
            ReDim Preserve Mssgs(0 To 13)
            xlt_frmUserInfo.Controls("lblStatus" & Format(iLabel, "0")).Caption = Join(Mssgs, vbCrLf)
        End If


End With


With xlt_frmUserInfo
    If .Controls("lblStatus" & Format(iLabel, "0")).Caption = "" Or iLabel = 3 Then
        .Controls("lblStatus" & Format(iLabel, "0")).Caption = Message
    Else
        .Controls("lblStatus" & Format(iLabel, "0")).Caption = .Controls("lblStatus" & Format(iLabel, "0")).Caption & vbCrLf & Message
    End If
    .Repaint
        
End With
End Sub

Hope that helps.

 

[MartinS]

Tony
That's great, and works perfectly! It's only ever going to be relevant to the second label, and as the code is an add-in, I've gone with a global variable instead, and it works a treat!
Here's my variation on your code - much appreciated!

Sub UpdateUserInfoStatus(iLabel As Integer, Message As String)
'\* define the maximum number of messages to display...
Const MaxMessages   As Integer = 14
Dim MsgArray        As Variant
Dim i               As Integer
'\* set userform association...
With xlt_frmUserInfo
    If iLabel = 1 Or iLabel = 3 Or .Controls("lblStatus" & Format(iLabel, "0")).Caption = "" Then
        .Controls("lblStatus" & Format(iLabel, "0")).Caption = Message
    Else
        MessageCounter = MessageCounter + 1
        If MessageCounter > MaxMessages Then
            MsgArray = Split(.Controls("lblStatus" & Format(iLabel, "0")).Caption, vbCrLf)
            For i = 0 To UBound(MsgArray) - 1
                MsgArray(i) = MsgArray(i + 1)
            Next i
            ReDim Preserve MsgArray(0 To MaxMessages - 1)
            .Controls("lblStatus" & Format(iLabel, "0")).Caption = Join(MsgArray, vbCrLf)
        End If
        .Controls("lblStatus" & Format(iLabel, "0")).Caption = .Controls("lblStatus" & Format(iLabel, "0")).Caption & vbCrLf & Message
    End If
    .Repaint
End With
End Sub

Thanks again
Martin

 

[Snakehips]

Martin,

You are welcome.
Looks good, thanks for the feedback.