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

[Tom Schreiner]

See if this works:

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

Tom

[ This Message was edited by: TsTom on 2002-05-13 08:54 ]