Tom Ogilvy
12/17/2006 9:40:00 PM
Perhaps somethingl like this:
Private Sub Worksheet_Change(ByVal target As Excel.Range)
' This Code with allow the user to input Times as a 730, 1800 value in the
designated range, and convert to actual AM/PM Times....
Dim TimeStr As String
On Error GoTo EndMacro
If target.Cells.Count > 1 Then
Exit Sub
End If
If Not Application.Intersect(target,
Range("C7:C8,C11:C12,C15:C16,F7:F8," &
"F11:F12,F15:F16,I7:I8,I11:I12,I15:" & _
"I16,L7:L8,L11:L12,L15:L16,O7:O8,O11" & _
":O12,O15:O16,R7:R8,R11:R12,R15:R16," & _
"U7:U8,U11:U12,U15:U16,V2:X2"))
Is Nothing Then
If not target.Value = "" Then
Application.EnableEvents = False
On Error Resume Next
With target
If .HasFormula = False Then
Select Case Len(.Value)
Case 1 ' e.g., 1 = 00:01 AM
TimeStr = "00:0" & .Value
Case 2 ' e.g., 12 = 00:12 AM
TimeStr = "00:" & .Value
Case 3 ' e.g., 735 = 7:35 AM
TimeStr = Left(.Value, 1) & ":" & _
Right(.Value, 2)
Case 4 ' e.g., 1234 = 12:34
TimeStr = Left(.Value, 2) & ":" & _
Right(.Value, 2)
Case 5 ' e.g., 12345 = 1:23:45 NOT 12:03:45
TimeStr = Left(.Value, 1) & ":" & _
Mid(.Value, 2, 2) & ":" & Right(.Value, 2)
Case 6 ' e.g., 123456 = 12:34:56
TimeStr = Left(.Value, 2) & ":" & _
Mid(.Value, 3, 2) & ":" & Right(.Value, 2)
Case Else
Err.Raise 0
End Select
if err.Number = 0 then
.Value = TimeValue(TimeStr)
else
MsgBox "Not a Valid Time !!!" & vbCrLf & vbCrLf & vbTab & "Enter Times
in as
a 24hr format." & vbCrLf & vbCrLf & vbTab & vbTab & vbTab & "EG. 0730 & 1530
format !!!", , "...."
err.clear
end if
End If
End With
Application.EnableEvents = True
End if
' This code with check if there is a Time in RANGE1 that is < a Time Value
in RANGE2 provided it is in the same Column....
Const WS_RANGE1 As String =
"C11,C15,F11,F15,I11,I15,L11,L15,O11,O15,R11,R15,U11,U15"
Const WS_RANGE2 As String =
"C8,C12,F8,F12,I8,I12,L8,L12,O8,O12,R8,R12,U8,U12"
Const msg As String = _
"There is an overlap in the Times Entered." & vbNewLine & _
"The next Start Time needs to be equal or greater than the previous
Finish Time."
If Not Intersect(target, Range(WS_RANGE1)) Is Nothing Then
If target.Value = "" Or target.Offset(-3, 0).Value = "" Then
Exit Sub
End If
If target.Offset(-3, 0).Value > target.Value And _
target.Offset(-2, 0).Value <> Range("V17").Value Then
MsgBox msg, , "...."
target.Offset(0, 0).ClearContents
target.Offset(0, 0).Select
End If
ElseIf Not Intersect(target, Range(WS_RANGE2)) Is Nothing Then
If target.Value = "" Or target.Offset(-2, 0).Value = "" Then
Exit Sub
End If
If target.Value < target.Offset(-2, 0).Value And _
target.Value < Range("V17").Value Then
MsgBox msg, , "...."
target.ClearContents
target.Select
End If
End If
End Sub
--
Regards,
Tom Ogilvy
"Corey" <me@work.still> wrote in message
news:ucdwfCiIHHA.3424@TK2MSFTNGP02.phx.gbl...
> There is NO problem with the Code 1, it works great.
> Code 2 does work, but the user needs to Re-Enter the cell for the msgbox
> to appear.
> I need it to work if the user leaves the cell, and a value is found that
> requires the msgbox to appear works.
>
> So i was wondering if there is a way BOTH codes can be utilised within the
> WorkSheet_Change and
> yet both operate correctly then ?
>
>
>
> Code 1:
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> Private Sub Worksheet_Change(ByVal target As Excel.Range)
> ' This Code with allow the user to input Times as a 730, 1800 value in the
> designated range, and convert to actual AM/PM Times....
> Dim TimeStr As String
> On Error GoTo EndMacro
> If Application.Intersect(target,
> Range("C7:C8,C11:C12,C15:C16,F7:F8,F11:F12,F15:F16,I7:I8,I11:I12,I15:I16,L7:L8,L11:L12,L15:L16,O7:O8,O11:O12,O15:O16,R7:R8,R11:R12,R15:R16,U7:U8,U11:U12,U15:U16,V2:X2"))
> Is Nothing Then
> Exit Sub
> End If
> If target.Cells.Count > 1 Then
> Exit Sub
> End If
> If target.Value = "" Then
> Exit Sub
> End If ' this is code
>
> Application.EnableEvents = False
> With target
> If .HasFormula = False Then
> Select Case Len(.Value)
> Case 1 ' e.g., 1 = 00:01 AM
> TimeStr = "00:0" & .Value
> Case 2 ' e.g., 12 = 00:12 AM
> TimeStr = "00:" & .Value
> Case 3 ' e.g., 735 = 7:35 AM
> TimeStr = Left(.Value, 1) & ":" & _
> Right(.Value, 2)
> Case 4 ' e.g., 1234 = 12:34
> TimeStr = Left(.Value, 2) & ":" & _
> Right(.Value, 2)
> Case 5 ' e.g., 12345 = 1:23:45 NOT 12:03:45
> TimeStr = Left(.Value, 1) & ":" & _
> Mid(.Value, 2, 2) & ":" & Right(.Value, 2)
> Case 6 ' e.g., 123456 = 12:34:56
> TimeStr = Left(.Value, 2) & ":" & _
> Mid(.Value, 3, 2) & ":" & Right(.Value, 2)
> Case Else
> Err.Raise 0
> End Select
> .Value = TimeValue(TimeStr)
> End If
> End With
> Application.EnableEvents = True
> Exit Sub
> EndMacro:
> MsgBox "Not a Valid Time !!!" & vbCrLf & vbCrLf & vbTab & "Enter Times in
> as a 24hr format." & vbCrLf & vbCrLf & vbTab & vbTab & vbTab & "EG. 0730 &
> 1530 format !!!", , "...."
> End Sub
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
>
> Code 2:
> Private Sub Worksheet_SelectionChange(ByVal target As Range)
> ' This code with check if there is a Time in RANGE1 that is < a Time Value
> in RANGE2 provided it is in the same Column....
> Const WS_RANGE1 As String =
> "C11,C15,F11,F15,I11,I15,L11,L15,O11,O15,R11,R15,U11,U15"
> Const WS_RANGE2 As String =
> "C8,C12,F8,F12,I8,I12,L8,L12,O8,O12,R8,R12,U8,U12"
>
> Const msg As String = _
> "There is an overlap in the Times Entered." & vbNewLine & _
> "The next Start Time needs to be equal or greater than the previous
> Finish Time."
>
> If Not Intersect(target, Range(WS_RANGE1)) Is Nothing Then
> If target.Value = "" Or target.Offset(-3, 0).Value = "" Then
> Exit Sub
> End If
> If target.Offset(-3, 0).Value > target.Value And _
> target.Offset(-2, 0).Value <> Range("V17").Value Then
> MsgBox msg, , "...."
> target.Offset(0, 0).ClearContents
> target.Offset(0, 0).Select
> End If
> ElseIf Not Intersect(target, Range(WS_RANGE2)) Is Nothing Then
> If target.Value = "" Or target.Offset(-2, 0).Value = "" Then
> Exit Sub
> End If
> If target.Value < target.Offset(-2, 0).Value And _
> target.Value < Range("V17").Value Then
> MsgBox msg, , "...."
> target.ClearContents
> target.Select
> End If
> End If
>
> End Sub
>
>
> Corey....
>
>