Code works but can't save template!

[shazadhussain88]

Hi all,

Hopefully you guys can help a real newbie with an issue im having with a Macro.

I have a excel file which i would like to share with my team to populate. There is a field where either a Yes or No option must be filled. The default field is 'Please Select'. I have added the below code which prevents the users from saving the file without entering either Yes or No.
Looks to be working fine, however now I am unsure how to save this template to distribute to the team!, as it keeps asking me to select yes or no. I want to save it as 'please select' and share with the team who from this point must select either yes or no. hopefully this makes sense!

ANy help would be appreciated !

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Application.ScreenUpdating = False
    Dim rng As Range
    For Each rng In Sheets("DCR").Range("E18:F18")
        If rng = "Please Select" Then
            MsgBox ("Please select 'Yes' or 'No' in cell " & rng.Address(0, 0))
            Cancel = True
            Exit For
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Application.ScreenUpdating = False
    Dim rng As Range
    For Each rng In Sheets("DCR").Range("E18:F18")
        If rng = "Please Select" Then
            MsgBox ("Please select 'Yes' or 'No' in cell " & rng.Address(0, 0))
            Cancel = True
            Exit For
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[Georgiboy]

Welcome to the forum,

You could run the below code to find your applications username:

Sub test()
    MsgBox Application.UserName
End Sub

Once you know that you could edit your codes to include a check for the username, and only fire if it is not you:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If Application.UserName <> "Joe Bloggs" Then ' change the Joe Bloggs to your username
        Application.ScreenUpdating = False
        Dim rng As Range
       
        For Each rng In Sheets("DCR").Range("E18:F18")
            If rng = "Please Select" Then
                MsgBox ("Please select 'Yes' or 'No' in cell " & rng.Address(0, 0))
                Cancel = True
                Exit For
            End If
        Next rng
        Application.ScreenUpdating = True
    End If
End Sub

 

[shazadhussain88]

Welcome to the forum,

You could run the below code to find your applications username:

Sub test()
    MsgBox Application.UserName
End Sub

Once you know that you could edit your codes to include a check for the username, and only fire if it is not you:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If Application.UserName <> "Joe Bloggs" Then ' change the Joe Bloggs to your username
        Application.ScreenUpdating = False
        Dim rng As Range
      
        For Each rng In Sheets("DCR").Range("E18:F18")
            If rng = "Please Select" Then
                MsgBox ("Please select 'Yes' or 'No' in cell " & rng.Address(0, 0))
                Cancel = True
                Exit For
            End If
        Next rng
        Application.ScreenUpdating = True
    End If
End Sub

Thanks for the quick reply,

Appologies but could you please guide me on how to exactly run the code to find the applications username, not sure where i need to paste this to execute?

 

[Georgiboy]

In the VBE (Code window):
Right click on 'ThisWorkbook'
Goto 'Insert' / 'Module'
In the newly created module paste the sub 'test'

Back in Excel sheet:
Press ALT+F8
Select 'test'
Click the button 'Run'

You should see a message box with your username

 

[shazadhussain88]

In the VBE (Code window):
Right click on 'ThisWorkbook'
Goto 'Insert' / 'Module'
In the newly created module paste the sub 'test'

Back in Excel sheet:
Press ALT+F8
Select 'test'
Click the button 'Run'

You should see a message box with your username

Thank you very much!

so the result i get is; assume i need to copy it exactly in this format ? or will Shazad Hussein be the correct format?

 

[Georgiboy]

It will have to be the complete text: Hussein, Shazad (S.)

 

[shazadhussain88]

**** not sure what i;ve done but my code isn't working now!

 

[Georgiboy]

The code will not work for you with the changes made above, however, it should work for everyone except you. Maybe get someone else to test it?

 

[shazadhussain88]

so ended up with the below, and I was able to save it. however when any other user opens it they seem to be able to save it without any issue?

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Application.UserName <> "Hussein, Shazad (S.)" Then
Application.ScreenUpdating = False
Dim rng As Range
For Each rng In Sheets("DCR").Range("E18:F18")
If rng = "Please Select" Then
MsgBox ("Please select 'Yes' or 'No' in cell " & rng.Address(0, 0))
Cancel = True
Exit For
End If
Next rng
Application.ScreenUpdating = True
End If
End Sub

 

[Georgiboy]

Do you have the above code in the ThisWorkbook module?

Do you have 'Please Select' on sheet 'DCR' in one of the cells E18:F18 without any trailing/ leading spaces?