Add password in a button code to complete the action

Hello, i want to make a button to clear specific contents from my book. I find a code and i want little help to add some security on this

Sub ClearRanges()
Application.ScreenUpdating = False

    Worksheets("Sheet1").Range("A1:G37,F9:CT9,F14:CT14").ClearContents
    Worksheets("Sheet2").Range("A3:G55,F32:CT34,F13:CT77").ClearContents

Application.ScreenUpdating = True
End Sub

Now here, when i click on button, inform me for complete clearance of the contents ( are you sure for the contents clearance?). After the agreement, i want to ask me for personal password twice and then after clicking ok to completing the clearance.

Ranges are indicatives.

Hello my friend

Try this:

Sub ClearRanges()
Application.ScreenUpdating = False

  Dim sMyPassword As String
  Dim oIBox       As Object
  Dim iPassTry    As Integer

  sMyPassword = "123"
  iPassTry = 0

  If MsgBox("Are you sure for the contents clearance?", vbYesNo + vbInformation + vbDefaultButton1) = vbYes Then

TryPassword:
    If InputBox("Please enter the password to clear ranges.") <> sMyPassword Then
      iPassTry = iPassTry + 1
      If iPassTry = 2 Then
        MsgBox "Incorrect password. Call the support"
        GoTo ExitSub
      Else
        MsgBox "Incorrect password.  Please try again"
        GoTo TryPassword
      End If
    Else
      Worksheets("Sheet1").Range("A1:G37,F9:CT9,F14:CT14").ClearContents
      Worksheets("Sheet2").Range("A3:G55,F32:CT34,F13:CT77").ClearContents
      MsgBox "Success!"
    End If
  End If
  
ExitSub:
Application.ScreenUpdating = True
End Sub

If it solves your problem, please mark the Thread as [SOLVED] and add reputation.

Give me a feedback

Thanks :D

Originally Posted by NeedForExcel

Give this a try -

Sub ClearRanges()

    Dim Ans, TypedPass1 As String, TypedPass2 As String
    Const Password As String = "XXX"
    
    Ans = MsgBox("Are You Sure You Want To Clear Ranges?", vbOKCancel)
    
    If Ans = 2 Then Exit Sub
    
    TypedPass1 = UCase(InputBox("Input Password", "Enter Password"))
    TypedPass2 = UCase(InputBox("Input Password", "Enter Password"))
    
    If TypedPass1 <> TypedPass2 Then MsgBox "Passwords Don't Match", vbCritical: Exit Sub
    If TypedPass1 <> Password Or TypedPass2 <> Password Then MsgBox "Passwords Don't Match", vbCritical: Exit Sub
    
    If Ans = 1 And TypedPass1 = TypedPass2 And TypedPass1 = Password Then
        Worksheets("Sheet1").Range("A1:G37,F9:CT9,F14:CT14").ClearContents
        Worksheets("Sheet2").Range("A3:G55,F32:CT34,F13:CT77").ClearContents
    End If
    
End Sub

When i change the password XXX with alphanumeric and trying to work the button it says Passwords Don't Match. What i'm doing wrong?

Both options work nicely! But, according to what I asked, closer is the code of Deep Dave. Thanks both of you for the help!
Can i have in all msgboxs titles and not "Microsoft Excel" ?

@Immortal2014

Try changing:

Const Password As Variant = "XXX"

So you will be abble to put any kind of value

Don't know if it solves your problem anyway

Don't forget to put it in " "

I'll try both solutions and if it happened again then I'll upload a sample. Thanks again.

Well, i found what was going wrong with the phrase "Passwords don't match". In my personal password using uppercase, lowercase and numbers, with no results . I try only with uppercase, numbers and special characters and the password is accepted. Why this happened?

String & Variant works well too.

In this situation can I delete the UCase from tho lines of code? Sorry for my questions but I'm not familiar with vba..