Prevent users to add worksheets

[dotchieJack]

Ihave this code that works fine

Option Explicit
Private Sub Workbook_NewSheet(ByVal Sh As Object)
   
  With Application
  .ScreenUpdating = False
  .DisplayAlerts = False
   
   
  ActiveSheet.Delete
   
  MsgBox "Je kan geen blad toevoegen!", 16
   
   
  .DisplayAlerts = True
  .ScreenUpdating = True
  End With
   
End Sub

But i would like to change it , when i get the message box and if i am an administrator i can fill in a pasword and add a sheet , but not the nomal users
Any help welcome

 

[shrivallabha]

Like below?

Option Explicit
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim vbMsg As VbMsgBoxResult
Dim strPassword As String
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
 
    vbMsg = MsgBox("You need administrator password to add new sheet!" & vbCrLf & "Do you have admin password?", vbYesNo)
    If vbMsg = vbYes Then
        strPassword = Application.InputBox("Provide Admin Password", "Password")
        If strPassword <> "abcd" Then
            MsgBox "Wrong Password. Sheet will be deleted!", vbExclamation
            ActiveSheet.Delete
            MsgBox "Je kan geen blad toevoegen!", 16
        End If
    Else
        ActiveSheet.Delete
        MsgBox "Je kan geen blad toevoegen!", 16
    End If
   
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
 
End Sub

 

[dotchieJack]

Hello Shrivallabha,
Works great ,thank you , thank you