Macro (password)

[Mike]

I have this macro now i would like to set this cell with a password is this
possible

Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
If Intersect(Target, Range("C300")) Is Nothing Then Exit Sub
ActiveSheet.Tab.ColorIndex = 15
End Sub

 

[JLatham]

Mike, Explain a little more about what you want to happen and when you want
it to happen.

Are you wanting to require someone to enter a password before they can
change the contents of a particular cell, such as C300? If that's the case,
you'd need to use either the individual Worksheet_SelectionChange() event
handler, or the Workbook_SheetSelectionChange() event handler. If you use
the Workbook_ event processes, then your code will be effective for all
sheets in the workbook unless you put code into it to restrict it to a few
specific sheets by name.

 

[Jim Thomlinson]

Cells don't have passwords. Sheets have passwords. Cells are just locked or
unlocked Locked cells are not editable if the sheet is password protected.

So what exactly do you want?

 

[Dave Peterson]

If you're using xl2002+ (I think this feature was added in xl2002???).

You can protect the sheet, but allow some users to edit certain ranges.

In xl2003 menus:
tools|protection|allow users to edit ranges

Remember that this works only after the sheet is protected.

But if you wanted to use code, I don't think I'd use the workbook_sheetchange
event.

Either the sheet's Worksheet_SelectionChange event or the Worksheet_Change event
would make more sense to me. (But either of these would only work if macros are
enabled and events are enabled.)

Only use one of these--not both.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myRngToInspect As Range
Dim myPWD As String
Dim UserPWD As String

myPWD = "myPassWorD"

Set myRngToInspect = Me.Range("C300")

If Intersect(Target, myRngToInspect) Is Nothing Then
Exit Sub
End If

UserPWD = InputBox(Prompt:="What's the password, Kenny?")

If UserPWD <> myPWD Then
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
End With
MsgBox "Incorrect password for this cell--reverting to old value!"
End If

End Sub

Or use the _selectionchange event...

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim myRngToInspect As Range
Dim myPWD As String
Dim UserPWD As String

myPWD = "myPassWorD"

Set myRngToInspect = Me.Range("C300")

If Intersect(Target, myRngToInspect) Is Nothing Then
Exit Sub
End If

UserPWD = InputBox(Prompt:="What's the password, Kenny?")

If UserPWD <> myPWD Then
With Application
.EnableEvents = False
.Goto Me.Range("A1") 'send them somewhere else
.EnableEvents = True
End With
MsgBox "Incorrect password for this cell--You can't select it!"
End If

End Sub

These routines don't go into the the ThisWorkbook module. They (just one) go
under the sheet that should have this behavior.

 

[Mike]

cell C300 when any data is entered into this cell it will change Tab colour
now what i want is to enter QC only so that the Tab colour will change on
each sheet (I do have 52 sheets for this workbook) to indicate sheet is
complete & the macro i used does not allow for this I need help !!

 

[Mike]

What i Want is to Type a specific word like QC In cel C300 & have this allow
the Tab to change colour to indicate sheet is complete BY the way Merry
Christmas

 

[Dave Peterson]

Are you running a version of excel that allows you to protect ranges?

If yes, then you can rely on that to allow you to make the change and use
simpler code like:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myRngToInspect As Range

Set myRngToInspect = Me.Range("C300")

If Target.Cells.Count > 1 Then
Exit Sub
End If

If Intersect(Target, myRngToInspect) Is Nothing Then
Exit Sub
End If

If LCase(Target.Value) = LCase("qc") Then
Me.Tab.ColorIndex = 3 'red for me
Else
Me.Tab.ColorIndex = xlNone 'change it back
End If

End Sub

But if you're not, your code has to do more:


Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myRngToInspect As Range
Dim myPWD As String
Dim UserPWD As String

myPWD = "myPassWorD"

Set myRngToInspect = Me.Range("C300")

If Intersect(Target, myRngToInspect) Is Nothing Then
Exit Sub
End If

UserPWD = InputBox(Prompt:="What's the password, Kenny?")

If UserPWD <> myPWD Then
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
End With
MsgBox "Incorrect password for this cell--reverting to old value!"
Else
If LCase(myRngToInspect.Value) = LCase("qc") Then
Me.Tab.ColorIndex = 3 'red for me
Else
Me.Tab.ColorIndex = xlNone 'change it back
End If
End If
End Sub