Before Save VBA Problem

[Hannah24]

Hi,

I have written the before save VBA which prevents someone from saving the workbook when certain cells are left blank.

I want to use this as a template and to save the workbook with the cells blank however, when any other user opens and tries to save, I want my message to appear and them to be unable to save. How do I amend my VBA to allow me to save as the editor ONLY?

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If WorksheetFunction.CountA(Worksheets("Sheet1").Range("E1,D7,C5,D11,X4,D15")) < 6 Then
MsgBox "Workbook will not be saved unless" & vbCrLf & _
"all required fields have been filled in!"
Cancel = True
End If
End Sub

Is anyone able to assit?

Many thanks,

Hannah

 

[DataBlake]

How do I amend my VBA to allow me to save as the editor ONLY?

You can protect your workbook with a password.
I use this to never allow a user to save even when pressing the red x at the top right
this is used in my "ThisWorkbook" Module

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Password As String
Dim EnteredPassword As String

Password = "BlakeSkate"
EnteredPassword = InputBox("Enter password to save changes")
If EnteredPassword <> Password Then
Cancel = True
MsgBox ("Password incorrect, file not saved")
End If

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    ThisWorkbook.Saved = True

End Sub

 

[Hannah24]

Hi @DataBlake,

Thank you for this, but I do not believe this is exactly what I am looking for.

My workbook is a Template with fields that I need individuals to complete. The VBA I have written is to ensure that certain (mandatory) cells are completed before they save.

The VBA I have written works as expected, as in the document cannot be saved with those cells remaining blank. However, it is working little too well, as it will not let me save the template with those cells blank. I (as the editor) need to be able to save the template with those cells remaining blank, so that when other users open to complete it, the cells are originally blank and the VBA will work if they leave them blank, when they themselves try to save.

Does this make sense?

Thanks,

Hannah

 

[DataBlake]

I (as the editor) need to be able to save the template with those cells remaining blank

ah that makes sense. then you can make use of a shortcut like this:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
if Application.UserName = "Your User Name" then goto exx


If WorksheetFunction.CountA(Worksheets("Sheet1").Range("E1,D7,C5,D11,X4,D15")) < 6 Then
MsgBox "Workbook will not be saved unless" & vbCrLf & _
"all required fields have been filled in!"
Cancel = True
End If

exx:
End Sub

if you need to determine what your application username is then use this macro standalone

Sub Appl_UserNamel()
    MsgBox Application.UserName
End Sub

 

[DataBlake]

or maybe

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

If WorksheetFunction.CountA(Worksheets("Sheet1").Range("E1,D7,C5,D11,X4,D15")) < 6 Then
MsgBox "Workbook will not be saved unless" & vbCrLf & _
"all required fields have been filled in!"
Cancel = True
End If

if Application.UserName = "Your User Name" then Cancel = False
End Sub

 

[Hannah24]

Hi @DataBlake ,

That has worked perfectly, thank you very much.

Hannah

 

[DataBlake]

Glad i could help!