fill a cell with color when sheet protected or unprotected

harveya915

Board Regular
Joined
Sep 4, 2015
Messages
141
I created a button that when clicked opens up a text box. I can then input the unprotect pword into this text box and it will unlock the sheet. Then I have another button set up so that when clicked it automatically protects the sheet. I'm looking for a code that when the unprotect pword is put in correctly in to the text box it will fill cell A1 green. And a code that when the lock button is clicked it will fill cell A1 red.

Please let me know where this code goes as well. In the Userform, the sheet or this workbook.

Much thanks!
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Since you already have macro running, one way of doing this is having a macro enter a value of 1 in cell A1 (or any cell you want to dedicate to it) when you unlock the sheet, and value of 0 in the same cell when you lock it. Then just use conditional formatting on cell A1 to fill cell with whatever color you like depending on cell's value.
 
Upvote 0
Can you post the 2 macros assigned to the 2 buttons?
 
Upvote 0
Can you post the 2 macros assigned to the 2 buttons?


Sure! Below is the code for unprotecting the sheet

Code:
Private Sub CommandButton7_Click()
  Dim wSheet As Worksheet
  Dim pword As String
    pword = "2019"
    
    If pword <> TextBox2.Text Then
        MsgBox "Invalid Password", vbCancel
        Exit Sub
    Else:
         For Each wSheet In Worksheets
           If wSheet.ProtectContents = True Then
              wSheet.Unprotect Password:=pword
           Else
              wSheet.Protect Password:=pword
           End If
        Next wSheet
    End If
    
Unload Me

End Sub

And below is the code for protecting the sheet.

Code:
Private Sub CommandButton5_Click()

Worksheets("Sheet1").Protect Password:="2019"
Unload UserForm1

End Sub

However, I just realized that I have another code for another button that when clicked will unprotect the sheet to run the code and then once the code has executed it will protect the sheet once again.

Code:
Private Sub InsertNewWeek_Click()
Sheet1.Activate
Worksheets("Sheet1").Unprotect Password:="2019"

Dim AddColumns()
'Inserts Columns at c-h
Worksheets(1).Range("c:h").EntireColumn.Insert
Worksheets(1).Range("c3").Formula = "End Week Total"
Worksheets(1).Range("d3").Formula = "Used"
Worksheets(1).Range("e3").Formula = "Restocked"
Worksheets(1).Range("f3").Formula = "Price Per Item"
Worksheets(1).Range("g3").Formula = "Purchase Total"
Worksheets(1).Range("h3").Formula = ""

Dim FillFormula()
Range("C4").Formula = "=I4-D4+E4"
Range("C4", "C" & Cells(Rows.Count, 1).End(xlUp).Row).FillDown
Range("G4").Formula = "=E4*F4"
Range("G4", "G" & Cells(Rows.Count, 1).End(xlUp).Row).FillDown

Dim columnWidthMultipleColumns()
Worksheets(1).Range("C:G").columnWidth = 12

Dim FormatCell()
Range("F:G").NumberFormat = "$#,##0.00"
Range("C:G").WrapText = True
Range("C2:G2").MergeCells = True
Range("C2").Value = Date

Worksheets("Sheet1").Protect Password:="2019"

Unload UserForm1

End Sub
 
Upvote 0
Try the following:
Code:
Private Sub CommandButton7_Click()
    Dim wSheet As Worksheet, pword As String
    pword = "2019"
    If pword <> TextBox2.Text Then
        MsgBox "Invalid Password", vbCancel
        Exit Sub
    Else:
        For Each wSheet In Sheets
            If wSheet.ProtectContents = True Then
                wSheet.Unprotect Password:=pword
                wSheet.Range("A1").Interior.ColorIndex = 4
            Else
                wSheet.Range("A1").Interior.ColorIndex = 3
                wSheet.Protect Password:=pword
            End If
        Next wSheet
    End If
    Unload Me
End Sub
Private Sub CommandButton5_Click()
    With Worksheets("Sheet1")
        .Range("A1").Interior.ColorIndex = 3
        .Protect Password:="2019"
    End With
    Unload UserForm1
End Sub
Private Sub InsertNewWeek_Click()
    With Sheets("Sheet1")
        .Unprotect Password:="2019"
        .Range("C:H").EntireColumn.Insert
        .Range("C3:H3") = Array("End Week Total", "Used", "Restocked", "Price Per Item", "Purchase Total", "")
        .Range("C4").Formula = "=I4-D4+E4"
        .Range("C4", "C" & Cells(Rows.Count, 1).End(xlUp).Row).FillDown
        .Range("G4").Formula = "=E4*F4"
        .Range("G4", "G" & Cells(Rows.Count, 1).End(xlUp).Row).FillDown
        .Range("C:G").ColumnWidth = 12
        .Range("F:G").NumberFormat = "$#,##0.00"
        .Range("C:G").WrapText = True
        .Range("C2:G2").MergeCells = True
        .Range("C2").Value = Date
        .Range("A1").Interior.ColorIndex = 3
        .Protect Password:="2019"
    End With
    Unload UserForm1
End Sub
 
Upvote 0

Forum statistics

Threads
1,214,979
Messages
6,122,551
Members
449,088
Latest member
davidcom

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top