Combine 2 codes from WorkSheet_Change & WorkSheet _SelectionChange to ONLY WorkSheet_Change

C

Corey

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....
 
T

Tom Ogilvy

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
 
C

Corey

Thank you Tom.
Beautiful.

Corey....
Tom Ogilvy said:
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
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Combine two Codes into one Sheet 2
Combine Two Different Worksheet_Change codes 9
please help.is it possible re-edit macro to convert text like1530-2200 to time format automatically? 1
SelectionChange code will ONLY work if cell is Selected AGAIN. Need to work once cell in no longer s 3
Worksheet change time format 6
Excel 2007 ambiguous name detected:Worksheet_Change 3
Time format via Worksheet Change 5
Time Format on Worksheet Change 5

Top