Display wait message during code running

[YasserKhalil]

Hello everyone
In my sample I put a code that hide a shape .. I run this code at first to hide the shape created for this purpose
.. then I need to run the sub "Generate_Test_Data" ..it is supposed to display the shape during the code running then to hide it but it didn't
May you fix it for me?

Sub Hide_Display_Message()
    Application.ScreenUpdating = True
    With Sheet1.Shapes("Rectangle 1")
        .Visible = msoTrue = (Not Sheet1.Shapes("Rectangle 1").Visible)
    End With
End Sub

Sub Generate_Test_Data()
    Dim Data(1 To 100000, 1 To 2)
    Dim I As Long
   
    Run "Hide_Display_Message"
    Application.ScreenUpdating = False
        Rnd -5
        For I = 1 To UBound(Data)
            If Rnd >= 0.5 Then Cells(I, 1) = "X"
            If Rnd >= 0.5 Then Cells(I, 2) = "Y"
        Next I
    Application.ScreenUpdating = True
End Sub

 

[Nebu]

Hi:

You can simply give a one liner code to achieve this

Application.StatusBar = "Progress: " & I & " of 100000: " & Format(I / 100000, "0%")

The progress will displayed on the left hand corner of you workbook.

Find the attached.

Thanks

 

[Debaser]

Try:

    Hide_Display_Message
    Application.ScreenUpdating = True
    Application.ScreenUpdating = False

 

[Marc L]

Hi !

Just needs a DoEvents statement and, above all, a good logic !​

Sub Generate_Test_Data()
    Dim R As Long
    Columns("A:B").Clear
    Sheet1.Shapes("Rectangle 1").Visible = True
    DoEvents
    Application.ScreenUpdating = False
    Randomize
For R = 1 To Application.Min(100000, Rows.Count)
    If Rnd >= 0.5 Then Cells(R, 1) = "X"
    If Rnd >= 0.5 Then Cells(R, 2) = "Y"
Next
    Application.ScreenUpdating = True
    Sheet1.Shapes("Rectangle 1").Visible = False
End Sub

 

[Marc L]

Optimized version without DoEvents :​

Sub Generate_Test_Data()
                Dim R As Long
    With Sheet1
        .Shapes("Button 1").Visible = False
        .Shapes("Rectangle 1").Visible = True
        .Columns("A:B").Clear
        Application.ScreenUpdating = False
        Randomize
    For R = 1 To Application.Min(100000, Rows.Count)
        If Rnd >= 0.5 Then .Cells(R, 1) = "X"
        If Rnd >= 0.5 Then .Cells(R, 2) = "Y"
    Next
        Application.ScreenUpdating = True
        .Shapes("Rectangle 1").Visible = False
        .Shapes("Button 1").Visible = True
    End With
End Sub

 

[Marc L]

Fastest way with an array variable :​

Sub Generate_Test_Data()
                Dim R As Long
              ReDim AR(1 To Application.Min(100000, Rows.Count), 1 To 2) As String
    With Sheet1
        .Shapes("Button 1").Visible = False
        .Shapes("Rectangle 1").Visible = True
        .Columns("A:B").Clear
        Randomize
    For R = 1 To UBound(AR)
        If Rnd >= 0.5 Then AR(R, 1) = "X"
        If Rnd >= 0.5 Then AR(R, 2) = "Y"
    Next
        .[A1:B1].Resize(UBound(AR)).Value = AR
        .Shapes("Rectangle 1").Visible = False
        .Shapes("Button 1").Visible = True
    End With
End Sub

 

[Marc L]

Without clearing columns (as an array is so fast), DoEvents is necessary :​

Sub Generate_Test_Data()
                Dim R As Long
              ReDim AR(1 To Application.Min(100000, Rows.Count), 1 To 2) As String
    With Sheet1
        .Shapes("Button 1").Visible = False
        .Shapes("Rectangle 1").Visible = True
        DoEvents
        Randomize
    For R = 1 To UBound(AR)
        If Rnd >= 0.5 Then AR(R, 1) = "X"
        If Rnd >= 0.5 Then AR(R, 2) = "Y"
    Next
        .[A1:B1].Resize(UBound(AR)).Value = AR
        .Shapes("Rectangle 1").Visible = False
        .Shapes("Button 1").Visible = True
    End With
End Sub

With that speed, the message shape is not really needed …​

You like ? So thanks to click on bottom right Like of each post !
​

 

[Marc L]

Last tip just using the shape button :​

Sub Generate_Test_Data()
                Dim R As Long
              ReDim AR(1 To Application.Min(100000, Rows.Count), 1 To 2) As String
    With Sheet1
        With .Shapes("Button 1").TextFrame.Characters
             .Text = "Wait …"
             .Font.ColorIndex = 3
        End With
              Randomize
    For R = 1 To UBound(AR)
        If Rnd >= 0.5 Then AR(R, 1) = "X"
        If Rnd >= 0.5 Then AR(R, 2) = "Y"
    Next
             .[A1:B1].Resize(UBound(AR)).Value = AR
        With .Shapes("Button 1").TextFrame.Characters
             .Text = "Process"
             .Font.ColorIndex = 10
        End With
    End With
End Sub

 

[YasserKhalil]

Thank you very much everybody for these great solutions provided
Really great .. So the key for this issue is the key word "DoEvents" ..
Can I simply have the idea of what is it doing?
Best Regards

 

[Marc L]

It's well explained in VBA inner help or via MSDN website !

DoEvents is not always necessary as I demonstrated …
​