Date stamp function

[Guest]

I am trying to use the time and date stamps worksheet event macro from
McGimpsey but running into a few problems.

1. The worksheet I'm using is protected and this code won't run when the
worksheet is protected.

2. I already have a Worksheet_Change function to format cells for upper and
proper case. Do I have to incorporate the time and date stamps worksheet
event macro into my change case macro, if so any suggestions would be greatly
appreciated. Here is a part of the code.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo CleanUp
Application.EnableEvents = False
Select Case Target.Address
Case "$J$4"
Target(1).Value = UCase(Target(1).Value)
Case "$AC$4"
Target(1).Value = StrConv(Target(1).Value, vbProperCase)
Case "$H$5"
Target(1).Value = StrConv(Target(1).Value, vbProperCase)
Case "$H$41"
Target(1).Value = StrConv(Target(1).Value, vbProperCase)
Case "$AW$4"
Target(1).Value = StrConv(Target(1).Value, vbProperCase)
Case "$BP$5"
Target(1).Value = UCase(Target(1).Value)
Case "$AP$7"
Target(1).Value = UCase(Target(1).Value)
Case "$F$7"
Target(1).Value = UCase(Target(1).Value)
Case "$BH$24"
Target(1).Value = UCase(Target(1).Value)
End Select
CleanUp:
Application.EnableEvents = True
End Sub

3. I would like to use the date stamp function for multiple entries(A60 to
A82). Here is what I had for one.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("AR60:BX60"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, -43).ClearContents
Else
With .Offset(0, -43)
.NumberFormat = "dd mmm yy hh:mm"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With

Sorry for the length of this post.

Tim

 

[Dave Peterson]

#1. You could unprotect and reprotect your worksheet right in the code.
#2. Since the ranges are mutually exclusive, you could check to see if you're
in one range and do what you want there.

I think I'd put the range addresses in a variable. I think it makes updates a
little easier:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myUpperRng As Range
Dim myProperRng As Range
Dim myDateTimeRng As Range

Set myUpperRng = Me.Range("$J$4,$BP$5,AP$7,$F$7,$BH$24")
Set myProperRng = Me.Range("$AC$4,$H$5,$H$41,$AW$4")
Set myDateTimeRng = Me.Range("AR60:BX60")

On Error GoTo ErrHandler:
Application.EnableEvents = False
Me.Unprotect Password:="hi"
With Target
If .Cells.Count > 1 Then Exit Sub
If Not (Intersect(myUpperRng, .Cells) Is Nothing) Then
.Value = StrConv(.Value, vbUpperCase)
ElseIf Not (Intersect(myProperRng, .Cells) Is Nothing) Then
.Value = StrConv(.Value, vbProperCase)
ElseIf Not (Intersect(myDateTimeRng, .Cells) Is Nothing) Then
If IsEmpty(.Value) Then
.Offset(0, -43).ClearContents
Else
With .Offset(0, -43)
.NumberFormat = "dd mmm yy hh:mm"
.Value = Now
End With
End If
End If
End With

ErrHandler:
Me.Protect Password:="hi"
Application.EnableEvents = True

End Sub

===========
PS. One of the nice things about "Select Case" is that you can do things like:

Select Case Target(1).Address '<--- note the (1)
Case "$J$4", "$BP$5", "$AP$7", "$F$7", "$BH$24"
Target(1).Value = UCase(Target(1).Value)
Case "$AC$4", "$H$5", "$H$41", "$AW$4"
Target(1).Value = StrConv(Target(1).Value, vbProperCase)
End Select

=========
I also figured that since you were only checking the first cell in the target,
you might as well just check to see if there's only one cell being changed.
That might not be ok for you.

 

[Guest]

Thanks, Dave

That seems to be working. I figured I would have unprotect and reprotect but
couldn't figure the code.

The date code is working for the first row but need to multiple entries
(AR61:BX61 onto AR80:BX80). The AR#:BX# are remarks column when some adds a
remark, I want to have it time stamped in the date column (0, -43).

Any suggestions how to incorporate these rows?

The upper/proper case code really cleans things up.

It's been awhile since I've checked in with the discussion group, but you
have always been helpful.

Thanks again

 

[Guest]

Dave I figured it out. Set myDateTimeRng = Me.Range("AR60:BX60,AR61:BX61,
etc.")

I do have one other question thou.
Is it possible to lock the range AR60:BX60, etc. after data has been added?
To stop any one from changing the entries. Right now they are fomatted
unlocked, so data can be entered.

 

[Dave Peterson]

Set myDateTimeRng = Me.Range("AR60:BX80")
would be a way to get that whole rectangular area (and less typing!).

Try adding one line to this portion:

ElseIf Not (Intersect(myDateTimeRng, .Cells) Is Nothing) Then
If IsEmpty(.Value) Then
.Offset(0, -43).ClearContents
Else
.locked = true '<----- added
With .Offset(0, -43)
.NumberFormat = "dd mmm yy hh:mm"
.Value = Now
End With
End If


Good luck,

 

[Guest]

Dave, I changed the Set myDateTimeRng = Me.Range("AR60:BX80"), your right
less typing.
When I add the .locked = true line. the date stamp no longer works. Not sure
why.

Thanks again

 

[Tom Ogilvy]

Are you unprotecting the sheet at the top of the routine and protecting it
at the bottom?

if not, do you have On Error Resume Next at the top of your module.

In any event, you need to unprotect the sheet at the top and protect it at
the bottom.

--
Regards,
Tom Ogilvy

Dave, I changed the Set myDateTimeRng = Me.Range("AR60:BX80"), your right
less typing.
When I add the .locked = true line. the date stamp no longer works. Not sure
why.

Thanks again