These date and time items are tough.

[cblincoln43]

I have the dates in column D, row 7 through 12. I have column H, rows 7 through 12 designated for codes.
I need to move the date for the row that i enter the code, M,S,A,E,H or W, into (column H 7 through 12) M=D18,S=D22,A=D25,E=D28,H=D31, AND W=D34.
I can't seem to make this formula work. The problem area is the;
MsgBox"in this cell you can only enter"&vbCrLf_
"M","S","A","E","H", or "W",",vbCrLf & _
"in upper case, without the quotes.",16,_
"a reminder..."
There will be numbers used in the same cells in column H., so I don't need this in the formula. Can anyone see why this formula does not move the date and how to drop the MsgBox prompt.
Thanks for putting up with these back again items. Bob

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("H7:H12")) Is Nothing Then
On Error GoTo ErrorHandler
Select Case Target.Value
Case Is = "M"
[D18].Value = Target.Offset(0, -4).Value
Case Is = "S"
[D22].Value = Target.Offset(0, -4).Value
Case Is = "A"
[D25].Value = Target.Offset(0, -4).Value
Case Is = "E"
[D28].Value = Target.Offset(0, -4).Value
Case Is = "H"
[D31].Value = Target.Offset(0, -4).Value
Case Is = "W"
[D34].Value = Target.Offset(0, -4).Value
Case Else
MsgBox "In this cell, you can only enter" & vbCrLf & _
"''M'', ''S'', ''A'', ''E'', ''H'', or ''W''," & vbCrLf & _
"in upper case, without the quotes.", 16, _
"A reminder..."
Application.EnableEvents = False
Target.Value = ""
Application.EnableEvents = True
End Select
End If
Exit Sub
ErrorHandler:
Target.Select
Exit Sub
End Sub

 

[Legacy 98055]

See if this works:<pre>

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ValRng As Range
On Error GoTo ErrorHandler
If Not Intersect(Target, Range("H7:H12")) Is Nothing Then
Set ValRng = ActiveSheet.Cells(Target.Row, 4)
Select Case Target.Value
Case "M"
[D18].Value = ValRng: Exit Sub
Case "S"
[D22].Value = ValRng: Exit Sub
Case "A"
[D25].Value = ValRng: Exit Sub
Case "E"
[D28].Value = ValRng: Exit Sub
Case "H"
[D31].Value = ValRng: Exit Sub
Case "W"
[D34].Value = ValRng: Exit Sub
Case Else
MsgBox "In this cell, you can only enter" & vbCrLf & _
"""M"", ""S"", ""A"", ""E"", ""H"", or ""W""," & vbCrLf & _
"in upper case, without the quotes.", 16, _
"A reminder..."
Application.EnableEvents = False
Target.Value = ""
Target.Select
Application.EnableEvents = True
End Select
Set ValRng = Nothing
End If
Exit Sub
ErrorHandler:
Target.Select
End Sub</pre>

Tom
This message was edited by TsTom on 2002-05-13 08:54