Keep Screen from Blanking out when doing a SaveAS from VBA

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

wheat01Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Roy CoxGroup Finance ManagerCommented:
I can see nothing in the code that would cause this. Is there a lot of calculations, maybe Array Formulas in the workbook?
regmigrantCommented:
what happens if you remove application.visible = false before the saveas?
Roy CoxGroup Finance ManagerCommented:
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

CompTIA Security+

Learn the essential functions of CompTIA Security+, which establishes the core knowledge required of any cybersecurity role and leads professionals into intermediate-level cybersecurity jobs.

wheat01Author 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 ManagerCommented:
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
Roy CoxGroup Finance ManagerCommented:
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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Roy CoxGroup Finance ManagerCommented:
Pleased to help.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.