Adjust VBA so workbook doesn't save when the pop up is canceled out

S

shapeshiftingkiwi

New Member
Joined
Mar 31, 2021
Messages
33
Office Version
  1. 365
Platform
  1. Windows
Hello,

The below code is working as intended except that I want the Save_As5 sub to only run if the "Save Production Form" button is clicked. Right now it is saving as soon as the macro is run and then the usual pop up with the save pathway is appearing afterwards.


VBA Code: 
Public Sub Save_Only()
English_Toggle
Dim Exitflag1 As Boolean, Exitflag2 As Boolean, Exitflag3 As Boolean, Exitflag4 As Boolean, Exitflag5 As Boolean, Exitflag6 As Boolean, Exitflag7 As Boolean
Dim fileSaved As Boolean
fileSaved = False
Save_As5 Exitflag1, Exitflag2, Exitflag3, Exitflag4, Exitflag5, Exitflag6, Exitflag7, fileSaved
End Sub

Private Sub Save_As5(ByRef Exitflag1 As Boolean, ByRef Exitflag2 As Boolean, ByRef Exitflag3 As Boolean, ByRef Exitflag4 As Boolean, ByRef Exitflag5 As Boolean, ByRef Exitflag6 As Boolean, ByRef Exitflag7 As Boolean, ByRef fileSaved As Boolean)
Exitflag1 = False
Exitflag2 = False
Exitflag3 = False
Exitflag4 = False
Exitflag5 = False
Exitflag6 = False
Exitflag7 = False
fileSaved = False
Dim ErrorCells As String
ErrorCells = ""
For Each Cell In ActiveSheet.Range("F14:F37")
    If Cell.EntireRow.Hidden = False And Cell.value = "" Then
        Exitflag1 = True
        ErrorCells = ErrorCells & Cell.Offset(0, -2).value & ", "
    End If
Next Cell

For Each Cell In ActiveSheet.Range("G14:G16,G18:G21,G27:G37")
    If Cell.EntireRow.Hidden = False And Cell.value = "" Then
        Exitflag2 = True
        ErrorCells = ErrorCells & Cell.Offset(0, -3).value & ", "
    End If
Next Cell

For Each Cell In ActiveSheet.Range("D5")
    If Cell.value = "" Then
        Exitflag3 = True
    End If
Next Cell

For Each Cell In ActiveSheet.Range("H5")
    If Cell.value = "" Then
        Exitflag4 = True
    End If
Next Cell

For Each Cell In ActiveSheet.Range("J5")
    If Cell.value = "" Then
        Exitflag5 = True
    End If
Next Cell

For Each Cell In ActiveSheet.Range("C55")
    If Cell.value = "" Then
        Exitflag6 = True
    End If
Next Cell

For Each Cell In ActiveSheet.Range("D57")
    If Cell.value = "" Then
        Exitflag7 = True
    End If
Next Cell

If Exitflag3 = True Then
    MsgBox "Enter a date"
ElseIf Exitflag4 = True Then
    MsgBox "Enter a shift"
ElseIf Exitflag5 = True Then
    MsgBox "Enter a line"
ElseIf Exitflag6 = True Then
    MsgBox "Verify un-used labels have been removed from floor"
ElseIf Exitflag7 = True Then
    MsgBox "Enter mill operator name"
    
Else
    If Exitflag1 = True And Exitflag2 = True Then
        MsgBox "missing information for " & ErrorCells
    ElseIf Exitflag1 = True Then
        MsgBox "missing lot number for " & ErrorCells
    ElseIf Exitflag2 = True Then
        MsgBox "missing quantity for " & ErrorCells
            Else
        With Application.FileDialog(msoFileDialogSaveAs)
           .Title = "Save"
           .ButtonName = "Save Production Form"
           .Application.DisplayAlerts = False
           ThisWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & Range("Save_As!T2").value, FileFormat:=52
           If .Show Then
              .Execute
              fileSaved = True
           End If
        End With
    End If
End If
End Sub
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
Sort by date Sort by votes
shapeshiftingkiwi said:
With Application.FileDialog(msoFileDialogSaveAs)
Click to expand...
That is to select a folder and file name.

But why do you need it if you have this line with the folder and the file name?
ThisWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & Range("Save_As!T2").value, FileFormat:=52

Also do you want to save the file with macros as an excel file?
 
Upvote 0
DanteAmor said:
That is to select a folder and file name.

But why do you need it if you have this line with the folder and the file name?
ThisWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & Range("Save_As!T2").value, FileFormat:=52

Also do you want to save the file with macros as an excel file?
Click to expand...
I should have said this initially, I leaned heavily on ChatGPT to help build this. I can't seem to use it to help figure out this last little bit though. I had it working but it didn't save the workbook as macro enabled (which I need it to) and then when I added that functionality it gave me the issue of the workbook saving before it should.

So to answer your question, I don't know why I need that first section but yes I do want it to save with macros.
 
Upvote 0
shapeshiftingkiwi said:
yes I do want it to save with macros
Click to expand...
Then you don't need to select the folder.
You only need to keep a copy of your book.

Replace the code you put in your original post with the following code (I simplified some parts):

VBA Code: 
Public Sub Save_Only()
  English_Toggle
  Dim Exitflag1 As Boolean, Exitflag2 As Boolean, Exitflag3 As Boolean, Exitflag4 As Boolean, Exitflag5 As Boolean, Exitflag6 As Boolean, Exitflag7 As Boolean
  Dim fileSaved As Boolean
  fileSaved = False
  Save_As5 Exitflag1, Exitflag2, Exitflag3, Exitflag4, Exitflag5, Exitflag6, Exitflag7, fileSaved
End Sub

Private Sub Save_As5(ByRef Exitflag1 As Boolean, ByRef Exitflag2 As Boolean, ByRef Exitflag3 As Boolean, ByRef Exitflag4 As Boolean, ByRef Exitflag5 As Boolean, ByRef Exitflag6 As Boolean, ByRef Exitflag7 As Boolean, ByRef fileSaved As Boolean)
  Dim ErrorCells As String
  ErrorCells = ""
  For Each Cell In ActiveSheet.Range("F14:F37")
    If Cell.EntireRow.Hidden = False And Cell.Value = "" Then
        Exitflag1 = True
        ErrorCells = ErrorCells & Cell.Offset(0, -2).Value & ", "
    End If
  Next Cell
  
  For Each Cell In ActiveSheet.Range("G14:G16,G18:G21,G27:G37")
    If Cell.EntireRow.Hidden = False And Cell.Value = "" Then
        Exitflag2 = True
        ErrorCells = ErrorCells & Cell.Offset(0, -3).Value & ", "
    End If
  Next Cell
  
  If ActiveSheet.Range("D5").Value = "" Then Exitflag3 = True
  If ActiveSheet.Range("H5").Value = "" Then Exitflag4 = True
  If ActiveSheet.Range("J5").Value = "" Then Exitflag5 = True
  If ActiveSheet.Range("C55").Value = "" Then Exitflag6 = True
  If ActiveSheet.Range("D57").Value = "" Then Exitflag7 = True
  
  If Exitflag3 = True Then
    MsgBox "Enter a date"
  ElseIf Exitflag4 = True Then
    MsgBox "Enter a shift"
  ElseIf Exitflag5 = True Then
    MsgBox "Enter a line"
  ElseIf Exitflag6 = True Then
    MsgBox "Verify un-used labels have been removed from floor"
  ElseIf Exitflag7 = True Then
    MsgBox "Enter mill operator name"
  Else
    If Exitflag1 = True And Exitflag2 = True Then
      MsgBox "missing information for " & ErrorCells
    ElseIf Exitflag1 = True Then
      MsgBox "missing lot number for " & ErrorCells
    ElseIf Exitflag2 = True Then
      MsgBox "missing quantity for " & ErrorCells
    Else
      ThisWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & Range("Save_As!T2").Value
    End If
  End If
End Sub


--------------
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
--------------
 
Upvote 0
I tried that, it saved to the pathway as type "file".

It also didn't bring up the dialog popup. I want the prompt to come up that shows what it's going to save as and will allow you to click "cancel" or x out and not save it.
 
Upvote 0
shapeshiftingkiwi said:
I tried that, it saved to the pathway as type "file".
Click to expand...
Sorry about that, it was my mistake.


shapeshiftingkiwi said:
I want the prompt to come up that shows what it's going to save as and will allow you to click "cancel" or x out and not save it.
Click to expand...

Done, now you have a window with an Ok button to save the file and a Cancel button:

VBA Code: 
Public Sub Save_Only()
  English_Toggle
  Dim Exitflag1 As Boolean, Exitflag2 As Boolean, Exitflag3 As Boolean, Exitflag4 As Boolean, Exitflag5 As Boolean, Exitflag6 As Boolean, Exitflag7 As Boolean
  Dim fileSaved As Boolean
  fileSaved = False
  Save_As5 Exitflag1, Exitflag2, Exitflag3, Exitflag4, Exitflag5, Exitflag6, Exitflag7, fileSaved
End Sub

Private Sub Save_As5(ByRef Exitflag1 As Boolean, ByRef Exitflag2 As Boolean, ByRef Exitflag3 As Boolean, ByRef Exitflag4 As Boolean, ByRef Exitflag5 As Boolean, ByRef Exitflag6 As Boolean, ByRef Exitflag7 As Boolean, ByRef fileSaved As Boolean)
  Dim ErrorCells As String, sf As String
  Dim msg As VbMsgBoxResult
 
  ErrorCells = ""
  For Each Cell In ActiveSheet.Range("F14:F37")
    If Cell.EntireRow.Hidden = False And Cell.Value = "" Then
        Exitflag1 = True
        ErrorCells = ErrorCells & Cell.Offset(0, -2).Value & ", "
    End If
  Next Cell
 
  For Each Cell In ActiveSheet.Range("G14:G16,G18:G21,G27:G37")
    If Cell.EntireRow.Hidden = False And Cell.Value = "" Then
        Exitflag2 = True
        ErrorCells = ErrorCells & Cell.Offset(0, -3).Value & ", "
    End If
  Next Cell
 
  If ActiveSheet.Range("D5").Value = "" Then Exitflag3 = True
  If ActiveSheet.Range("H5").Value = "" Then Exitflag4 = True
  If ActiveSheet.Range("J5").Value = "" Then Exitflag5 = True
  If ActiveSheet.Range("C55").Value = "" Then Exitflag6 = True
  If ActiveSheet.Range("D57").Value = "" Then Exitflag7 = True
 
  If Exitflag3 = True Then
    MsgBox "Enter a date"
  ElseIf Exitflag4 = True Then
    MsgBox "Enter a shift"
  ElseIf Exitflag5 = True Then
    MsgBox "Enter a line"
  ElseIf Exitflag6 = True Then
    MsgBox "Verify un-used labels have been removed from floor"
  ElseIf Exitflag7 = True Then
    MsgBox "Enter mill operator name"
  Else
    If Exitflag1 = True And Exitflag2 = True Then
      MsgBox "missing information for " & ErrorCells
    ElseIf Exitflag1 = True Then
      MsgBox "missing lot number for " & ErrorCells
    ElseIf Exitflag2 = True Then
      MsgBox "missing quantity for " & ErrorCells
    Else
      sf = ThisWorkbook.Path & "\" & Range("Save_As!T2").Value & ".xlsm"
      msg = MsgBox("The file will be saved as: " & vbCr & sf, vbOKCancel, "SAVE EXCEL WITH MACROS")
      If msg = vbOK Then
        ThisWorkbook.SaveCopyAs sf
      Else
        MsgBox "Process canceled"
      End If
    End If
  End If
End Sub

;)
 
Upvote 0
Alright this works. It doesn't have the usual save dialog that I like but I'm also reading that you can't use that save dialog popup to choose to save a file as macro enabled? In which case it seems like your solution is the best one.
 
Upvote 0
shapeshiftingkiwi said:
I don't know why I need that first section but yes I do want it to save with macros.
Click to expand...
shapeshiftingkiwi said:
It doesn't have the usual save dialog that I like but I'm also reading that you can't use that save dialog popup to choose to save a file as macro enabled?
Click to expand...
I am confused with your comments.
That dialog popup is to choose a folder and select a file.

But you already have the folder defined and the file name is taken from a cell; so what do you want the dialog window for, your thought is to pop up and then change the name and folder?

This is another try.

VBA Code: 
Public Sub Save_Only()
  English_Toggle
  Dim Exitflag1 As Boolean, Exitflag2 As Boolean, Exitflag3 As Boolean, Exitflag4 As Boolean, Exitflag5 As Boolean, Exitflag6 As Boolean, Exitflag7 As Boolean
  Dim fileSaved As Boolean
  fileSaved = False
  Save_As5 Exitflag1, Exitflag2, Exitflag3, Exitflag4, Exitflag5, Exitflag6, Exitflag7, fileSaved
End Sub

Private Sub Save_As5(ByRef Exitflag1 As Boolean, ByRef Exitflag2 As Boolean, ByRef Exitflag3 As Boolean, ByRef Exitflag4 As Boolean, ByRef Exitflag5 As Boolean, ByRef Exitflag6 As Boolean, ByRef Exitflag7 As Boolean, ByRef fileSaved As Boolean)
  Dim ErrorCells As String, sf As String
  Dim msg As VbMsgBoxResult
  
  ErrorCells = ""
  For Each cell In ActiveSheet.Range("F14:F37")
    If cell.EntireRow.Hidden = False And cell.Value = "" Then
        Exitflag1 = True
        ErrorCells = ErrorCells & cell.Offset(0, -2).Value & ", "
    End If
  Next cell
  
  For Each cell In ActiveSheet.Range("G14:G16,G18:G21,G27:G37")
    If cell.EntireRow.Hidden = False And cell.Value = "" Then
        Exitflag2 = True
        ErrorCells = ErrorCells & cell.Offset(0, -3).Value & ", "
    End If
  Next cell
  
  If ActiveSheet.Range("D5").Value = "" Then Exitflag3 = True
  If ActiveSheet.Range("H5").Value = "" Then Exitflag4 = True
  If ActiveSheet.Range("J5").Value = "" Then Exitflag5 = True
  If ActiveSheet.Range("C55").Value = "" Then Exitflag6 = True
  If ActiveSheet.Range("D57").Value = "" Then Exitflag7 = True
  
  If Exitflag3 = True Then
    MsgBox "Enter a date"
  ElseIf Exitflag4 = True Then
    MsgBox "Enter a shift"
  ElseIf Exitflag5 = True Then
    MsgBox "Enter a line"
  ElseIf Exitflag6 = True Then
    MsgBox "Verify un-used labels have been removed from floor"
  ElseIf Exitflag7 = True Then
    MsgBox "Enter mill operator name"
  Else
    If Exitflag1 = True And Exitflag2 = True Then
      MsgBox "missing information for " & ErrorCells
    ElseIf Exitflag1 = True Then
      MsgBox "missing lot number for " & ErrorCells
    ElseIf Exitflag2 = True Then
      MsgBox "missing quantity for " & ErrorCells
    Else
    
      With Application.FileDialog(msoFileDialogSaveAs)
        .Title = "Select file xlsm"
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path & "\" & Range("Save_As!T2").Value & ".xlsm"
        .FilterIndex = 2
        If .Show Then
          sf = .SelectedItems(1)
          ThisWorkbook.SaveCopyAs sf
        Else
          MsgBox "Process canceled"
        End If
      End With

    End If
  End If
End Sub

I hope this helps 😅
 
Upvote 0
Solution
That works! Thanks so much!

And yeah that dialog pop up isn't needed but I think it would help for the people that are using this to be able to see an interface they're used to. Although I might actually use your solution that doesn't have that popup now that I think about it because there is no scenario in which I would want them changing the pathway or the name.

Either way you've made it work. Thanks!
 
Upvote 1
You must log in or register to reply here.

Similar threads

S
  • Solved
Do not trigger next sub if exit flags in 1st sub are triggered
Replies
2
Views
247
Peter_SSs
Peter_SSs
S
  • Question
Code works but can't save template!
2 3
Replies
26
Views
786
shazadhussain88
S
P
  • Locked
  • Question
Edit VBA code to let it automatically create Folder
Replies
5
Views
455
RoryA
RoryA
Agnarr
  • Question
VBA problem with creating new sheets
Replies
0
Views
331
Agnarr
Agnarr
J
  • Question
VBA to save all indicated in range tabs as all separated PDFs with name of the tabs in the same place where the excel file is
Replies
5
Views
525
Jorgi
J

Forum statistics

Threads
1,214,391
Messages
6,119,244
Members
448,879
Latest member
VanGirl

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top