Date Stamp with protection
Mike, that's exactly what I wanted.
Thank you...again.
"Mike H" wrote:
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" wrote:
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" wrote:
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" wrote:
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
|