How to password protect a MACRO and set a specific cell value

[Adendum]

Hi Gurus,

I have a macro (courtesy of the wonderful forum) within a workbook that is used once a month to clear out all the data from specific cells so we can set up a new empty workbook for the next month.

The workbook contains several macros that users can and will use on a daily basis. Obviously I don't want any one running that macro accidentally during the month and, ideally, I would prefer the macro to only be run after entering a password (that only I will know). At the moment I am manually creating this macro at the time I want to do the clear down but if I can protect the macro I can keep it in the workbook.

Q1: Is that possible and how can I achieve this?

My cleardown macro deletes content from cells A2:C2000 in multiple sheets, with some excluded. However in column D2 to D2000 I have data validation cells with values set from the previous month. I would like to reset all D2:D2000 cells to the first in the list. The list is from another sheet called "Outcomes" and looks like this ='OUTCOMES'!$A$2:$A$12

Q2: If this is possible can I add this feature to the VBA below?

Sub Clear_Range()
'Clear off all data from sheets 01-31
Application.ScreenUpdating = False
Dim ans As Long
ans = ThisWorkbook.Sheets.Count
Dim i As Long

For i = 1 To ans
    If Sheets(i).Name <> "OUTCOMES" And Sheets(i).Name <> "Raw Data" And Sheets(i).Name <> "Action" And Sheets(i).Name <> "With List" Then Sheets(i).Range("A2: C2000").ClearContents
Next
Application.ScreenUpdating = True
End Sub

 

[Michael M]

Try this for the Password requirement

Sub Clear_Range()
'Clear off all data from sheets 01-31
Application.ScreenUpdating = False
Dim ans As Long, Pwd As String, chk As String
Pwd = "your password"
chk = InputBox("Please Insert you Password", "Password Required", vbOK)
If chk <> Pwd Then
MsgBox "Sorry, this Password is Invalid !!"
Exit Sub
End If
ans = ThisWorkbook.Sheets.Count
Dim i As Long

For i = 1 To ans
    If Sheets(i).Name <> "OUTCOMES" And Sheets(i).Name <> "Raw Data" And Sheets(i).Name <> "Action" And Sheets(i).Name <> "With List" Then Sheets(i).Range("A2: C2000").ClearContents
Next
Application.ScreenUpdating = True
End Sub

 

[Peter_SSs]

Other ideas:

It sounds like you are really trying to prevent accidental removal of data but of course if you put the password in the code as suggested by Michael, that password would be obtainable by other users if they want and know how. Of course an option to prevent that would be to password protect the vba as well.

If it is just accidental erasure that you are worried about and you trust the others you could take an approach like this which means to delete that data they have to both run the macro and confirm deletion.

Sub Sample_1()
  Dim Resp As VbMsgBoxResult
  
  Resp = MsgBox("Are you sure that you want to delete all data and start a new month?", vbYesNoCancel)
  If Resp = vbYes Then
    'Put all your delete code here
  End If
End Sub

Another approach that does not require a password or manual confirmation is to only allow the code if it is you logged in to the computer.
This idea included below but I also noted you code comment "Clear off all data from sheets 01-31". If that means the sheets in question are named "01", "02", ..., "31" and all 31 of those sheets always exist, then you might be able to use something like this. It doesn't require a password but it will not delete anything if other users run it

Sub Clear_Range_v2()
  'Clear off all data from sheets 01-31
  Dim i As Long
  
  If Environ("username") = "put your Windows login name here" Then
    Application.ScreenUpdating = False
    For i = 1 To 31
        With Sheets(Format(i, "00"))
          .Range("A2: C2000").ClearContents
          .Range("D2:D2000").Value = Sheets("OUTCOMES").Range("A2").Value
        End With
    Next i
    Application.ScreenUpdating = True
  End If
End Sub