Date Stamp with protection

[Sam H]

Hi,

I have the following text running as a macro in my spreadsheet, however I
now want to do two things, I have protected the cells where the date stamps
appear, therefore I need to know what and where I put the bit in my macro to
unprotect and re-prrotect the cells.

Also everytime it carries out the date stamping I would also like it to save
the entire spreadsheet.

Any help would be great.

Thanks

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("H:H"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, -5).ClearContents
Else
With .Offset(0, -5)
.NumberFormat = "dd/mm/yy"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
'New code
If Not Intersect(Range("H:H"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, -4).ClearContents
Else
With .Offset(0, -4)
.NumberFormat = "hh:mm"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
'New code
If Not Intersect(Range("Y:Y"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, 1).ClearContents
Else
With .Offset(0, 1)
.NumberFormat = "dd/mm/yy hh:mm"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
'New code
If Not Intersect(Range("AG:AG"), .Cells) Is Nothing Then
Application.EnableEvents = False
If UCase(Target.Value) = "CALL RESOLVED" Then
With .Offset(0, 1)
.NumberFormat = "dd/mm/yy hh:mm"
.Value = Now
End With
Else
With .Offset(0, 1)
.ClearContents
End With
End If
Application.EnableEvents = True
End If
End With
End Sub

 

[JLatham]

Since your code doesn't exit before the end of it all, the simplest thing to
do would be to put
Worksheet.Unprotect
just before the With Target statement, then put
Worksheet.Protect
right after the End With for the block, just before End Sub.

If you have the sheet protected with a password, it would be (substitute
appropriate password)
Worksheet.Unprotect password:="mySheetPassword"
and
Worksheet.Protect password:="mySheetPassword"

 

[Mike H]

Sam.

Fot this to work you must in turn select columns H, Y & AG and right click,
format cells - protection and un-check 'Locked'. I've also combined 2 of your
sections of code into 1

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("H:H"), .Cells) Is Nothing Then
ActiveSheet.Unprotect Password:="MyPass"
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, -5).ClearContents
.Offset(0, -4).ClearContents
Else
With .Offset(0, -5)
.NumberFormat = "dd/mm/yy"
.Value = Now
End With

With .Offset(0, -4)
.NumberFormat = "hh:mm"
.Value = Now
End With
End If
ActiveSheet.Protect Password:="MyPass"
Application.EnableEvents = True
End If

'New code
If Not Intersect(Range("Y:Y"), .Cells) Is Nothing Then
ActiveSheet.Unprotect Password:="MyPass"
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, 1).ClearContents
Else
With .Offset(0, 1)
.NumberFormat = "dd/mm/yy hh:mm"
.Value = Now
End With
End If
ActiveSheet.Protect Password:="MyPass"
Application.EnableEvents = True
End If
'New code
If Not Intersect(Range("AG:AG"), .Cells) Is Nothing Then
Application.EnableEvents = False
ActiveSheet.Unprotect Password:="MyPass"
If UCase(Target.Value) = "CALL RESOLVED" Then
With .Offset(0, 1)
.NumberFormat = "dd/mm/yy hh:mm"
.Value = Now
End With
Else
With .Offset(0, 1)
.ClearContents
End With
End If
ActiveSheet.Protect Password:="MyPass"
Application.EnableEvents = True
End If
End With
End Sub

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.

 

[Sam H]

Hi,

sorry but that didn't work, it comes up with a run time error.

 

[Sam H]

Hi Mike,

That worked great.

Ther only other thing I am looking for is that each time it adds a date/time
stamp that the whole spreadsheet saves. Are you able to help?

Thanks

 

[Mike H]

Sam.

Like this

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("H:H"), .Cells) Is Nothing Then
ActiveSheet.Unprotect Password:="MyPass"
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, -5).ClearContents
.Offset(0, -4).ClearContents
Else
With .Offset(0, -5)
.NumberFormat = "dd/mm/yy"
.Value = Now
End With

With .Offset(0, -4)
.NumberFormat = "hh:mm"
.Value = Now
End With
End If
ActiveSheet.Protect Password:="MyPass"
ThisWorkbook.Save
Application.EnableEvents = True
End If

'New code
If Not Intersect(Range("Y:Y"), .Cells) Is Nothing Then
ActiveSheet.Unprotect Password:="MyPass"
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, 1).ClearContents
Else
With .Offset(0, 1)
.NumberFormat = "dd/mm/yy hh:mm"
.Value = Now
End With
End If
ActiveSheet.Protect Password:="MyPass"
ThisWorkbook.Save
Application.EnableEvents = True
End If
'New code
If Not Intersect(Range("AG:AG"), .Cells) Is Nothing Then
Application.EnableEvents = False
ActiveSheet.Unprotect Password:="MyPass"
If UCase(Target.Value) = "CALL RESOLVED" Then
With .Offset(0, 1)
.NumberFormat = "dd/mm/yy hh:mm"
.Value = Now
End With
Else
With .Offset(0, 1)
.ClearContents
End With
End If
ActiveSheet.Protect Password:="MyPass"
ThisWorkbook.Save
Application.EnableEvents = True
End If
End With
End Sub

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.

 

[Sam H]

Mike, that's exactly what I wanted.

Thank you...again.