Keep Screen from Blanking out when doing a SaveAS from VBA

wheat01
wheat01 used Ask the Experts™
on
Excel 2013 64 bit windows 8.1 with powerpivot. as the only add-in. Workbook opens with a user form with command buttons which toggle to various worksheets. User form has an activex command button to save the work book to user selected directory and filename.
Causes users to run around with their hair on fire needlessly.

Command button code as follows:
Private Sub cmdSave_Click()
  Dim Test As Variant
  On Error Resume Next

  lblSaving.Visible = True

  With Application
    .ScreenUpdating = False
    .DisplayStatusBar = True 'kinda need this line
    .StatusBar = "Please wait while file is saved."
    DoEvents 'magic trick
    .DisplayAlerts = False
    .Calculation = xlManual 'sometimes excel calculates values before saving files
    .EnableEvents = False 'to avoid opened workbooks section open/save... to trigger
  End With
  
  Dim filesavename As String
  filesavename = Application.ActiveWorkbook.FullName
  Test = MsgBox("Do you want to save the current views", vbYesNo)
  If Test = vbYes Then
    filesavename = Application.GetSaveAsFilename( _
    FileFilter:="Excel Files (*.xlsb), *.xlsb")
    If Trim(filesavename) <> "" Then
      Test = MsgBox("Save as " & filesavename, vbYesNo + vbQuestion)
    Else
      lblSaving.Visible = False
      With Application
        .CutCopyMode = False
        .StatusBar = False
        .DisplayStatusBar = False
        .DisplayAlerts = True
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlAutomatic
      End With
      Exit Sub
    End If
    If Test = vbYes Then
'    ActiveWorkbook.Save
      Application.ScreenUpdating = False
      Application.Visible = False
      UserForm1.Show

  ********* Problem********
      ActiveWorkbook.SaveAs filesavename  ' screen goes blank (white) with the UserForm Title in the window


      DoEvents
      UserForm1.Show
      Application.Visible = True
      Application.ScreenUpdating = True
    Else
      lblSaving.Visible = False
      With Application
        .CutCopyMode = False
        .StatusBar = False
        .DisplayStatusBar = False
        .DisplayAlerts = True
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlAutomatic
      End With
      Exit Sub
    
    End If
      
  End If

  lblSaving.Visible = False
  With Application
        .CutCopyMode = False
        .StatusBar = False
        .DisplayStatusBar = False
        .DisplayAlerts = True
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlAutomatic
  End With
End Sub

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Roy CoxGroup Finance Manager

Commented:
I can see nothing in the code that would cause this. Is there a lot of calculations, maybe Array Formulas in the workbook?
what happens if you remove application.visible = false before the saveas?
Roy CoxGroup Finance Manager

Commented:
I've had time to take a closer look

Don't use the error handler, in fact always add error handlers when you are satisfied that the code works not before.

 On Error Resume Next

Open in new window


This will ignore errors and not give you error messages which nay point to the cause of a problem. Add the error handler when code is working as expected. In fact it is hiding the fact that the your code is trying to show the form whilst it is shown.

Try this code, note the changing events code is really not necessary, it does not improve speed at all

Option Explicit


Private Sub cmdSave_Click()
    Dim Test As Variant
    Dim filesavename As String

    On Error GoTo err_quit

    Me.lblSaving.Visible = True
''/// this is really unnecessary
    ''    With Application
    ''        .ScreenUpdating = False
    ''        .DisplayStatusBar = True    'kinda need this line
    ''        .StatusBar = "Please wait while file is saved."
    ''        DoEvents    'magic trick
    ''        .DisplayAlerts = False
    ''        .Calculation = xlManual    'sometimes excel calculates values before saving files
    ''        .EnableEvents = False    'to avoid opened workbooks section open/save... to trigger

    Test = MsgBox("Do you want to save the current views", vbYesNo)
    If Test = vbYes Then
        filesavename = Application.GetSaveAsFilename( _
                       FileFilter:="Excel Files (*.xlsb), *.xlsb")
        MsgBox filesavename
        If Trim(filesavename) <> "" Then
            Test = MsgBox("Save as " & filesavename, vbYesNo + vbQuestion)
        Else
            lblSaving.Visible = False
            Exit Sub
        End If
        If Test = vbYes Then
            '  ********* Problem********
            ThisWorkbook.SaveAs filesavename, FileFormat:=50    '///'xlsb  ' screen goes blank (white) with the UserForm Title in the window
            MsgBox "Workbook saved as " & filesavename, vbInformation, "Success"
        End If

    End If
    Exit Sub
err_quit:

    MsgBox "error occurred", vbCritical, "Not saved"
    Me.lblSaving.Visible = False

    .CutCopyMode = False
    .StatusBar = False
    .DisplayStatusBar = False
    .DisplayAlerts = True
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlAutomatic
End With
End Sub

Open in new window

Exploring ASP.NET Core: Fundamentals

Learn to build web apps and services, IoT apps, and mobile backends by covering the fundamentals of ASP.NET Core and  exploring the core foundations for app libraries.

Author

Commented:
Roy,

I substituted your suggested code exactly as you listed (thank you). Same Problem with the userform blanking out.  I tried some tests. I removed the data model, removed PowerPivot, removed all pivot tables, removed all tabs except the one to return to the user form. File size went from 172,000 kb down to 259 kb.  No Blinking screen.  

The user form appears to lose focus about 5-7 seconds after the saveas command is given. But at 259 kb, the save time is under that threshold.  I though maybe exlapsed time might be triggering it, but I put in a counter (for I = 1 to 1000000000)  but that didn't seem to trigger the issue.

I then filled up the Inventory worksheet with a lot of data (1,000,000 rows 52 columns)  Got the flicker at 5-7 seconds and user form went blank at about 7-8 seconds.  (Using your save code).  I have attached the slimmed down file with the large dataset on the Inventory tab.  File Saves correctly and User form is restored at the end of the files saveas, but the users freak out.  

Any further assistance would be appreciated.
UserFormBlanking.xlsb
Roy CoxGroup Finance Manager

Commented:
I have tested this many times and the problem occurs intermittently.

I will have another look after work this evening and apply a different solution
Group Finance Manager
Commented:
I have noticed that the userform displays a not responding message which convinces me that it is the form that is at fault. I would never bother using a userform even modelessly for this purpose.

The workbook takes such a long time to save I wonder if it might be corrupt

Anyway, this is how I would do it. The code unhides a very hidden sheet with the message on it, after the save as it then re-hides that sheet. It never crashes during testing and is a way that I have recommended before..
UserFormBlanking-33.xlsb
Roy CoxGroup Finance Manager

Commented:
Pleased to help.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial