Please help me combine these worksheet events

DouglasK

New Member
Joined
Jan 18, 2019
Messages
6
Please tell me how to combine these into a single VBA. Each one runs alone but I cannot figure out how to combine. Thanks. (The first one allows entry of date without use of / key and the second allows entry of time without :

Code:
[COLOR=#003366][FONT='inherit']Private Sub Worksheet_Change(ByVal Target As Excel.Range)[/FONT][/COLOR]

[COLOR=#003366][FONT='inherit']Dim DateStr As String[/FONT][/COLOR]

[COLOR=#003366][FONT='inherit']On Error GoTo EndMacro[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']If Application.Intersect(Target, Range("A1:A10")) Is Nothing Then[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']    Exit Sub[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']End If[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']If Target.Cells.Count > 1 Then[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']    Exit Sub[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']End If[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']If Target.Value = "" Then[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']    Exit Sub[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']End If[/FONT][/COLOR]

[COLOR=#003366][FONT='inherit']Application.EnableEvents = False[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']With Target[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']If .HasFormula = False Then[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']    Select Case Len(.Formula)[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']        Case 4 ' e.g., 9298 = 2-Sep-1998[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']            DateStr = Left(.Formula, 1) & "/" & _ [/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']            Mid(.Formula, 2, 1) & "/" & Right(.Formula, 2)[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']        Case 5 ' e.g., 11298 = 12-Jan-1998 NOT 2-Nov-1998[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']            DateStr = Left(.Formula, 1) & "/" & _ [/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']                Mid(.Formula, 2, 2) & "/" & Right(.Formula, 2)[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']        Case 6 ' e.g., 090298 = 2-Sep-1998[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']            DateStr = Left(.Formula, 2) & "/" & _ [/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']                Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']        Case 7 ' e.g., 1231998 = 23-Jan-1998 NOT 3-Dec-1998[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']            DateStr = Left(.Formula, 1) & "/" & _ [/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']                Mid(.Formula, 2, 2) & "/" & Right(.Formula, 4)[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']        Case 8 ' e.g., 09021998 = 2-Sep-1998[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']            DateStr = Left(.Formula, 2) & "/" & _ [/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']                Mid(.Formula, 3, 2) & "/" & Right(.Formula, 4)[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']        Case Else[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']            Err.Raise 0[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']    End Select[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']    .Formula = DateValue(DateStr)[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']End If[/FONT][/COLOR]

[COLOR=#003366][FONT='inherit']End With[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']Application.EnableEvents = True[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']Exit Sub[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']EndMacro:[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']MsgBox "You did not enter a valid date."[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']Application.EnableEvents = True[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']End Sub[/FONT][/COLOR]

Code:
[FONT=Arial][COLOR=#800000][FONT=Courier New][COLOR=#003366]Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim TimeStr As String

On Error GoTo EndMacro
If Application.Intersect(Target, Range("A1:A10")) 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

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:
[/COLOR][/FONT][/COLOR][/FONT][COLOR=#003366][FONT=Arial]MsgBox "You did not enter a valid time"
Application.EnableEvents = True
End Sub[/FONT][/COLOR]
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Combining two worksheet events into a single VBA

Please help. Each of these VBA events works alone but I can't get them to work combined. One allows the user to enter date without having to use / and the other allows entry of date without : Thanks. See code below:

Code:
[COLOR=#003366][FONT='inherit']Private Sub Worksheet_Change(ByVal Target As Excel.Range)[/FONT][/COLOR]

[COLOR=#003366][FONT='inherit']Dim DateStr As String[/FONT][/COLOR]

[COLOR=#003366][FONT='inherit']On Error GoTo EndMacro[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']If Application.Intersect(Target, Range("A1:A10")) Is Nothing Then[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']    Exit Sub[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']End If[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']If Target.Cells.Count > 1 Then[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']    Exit Sub[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']End If[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']If Target.Value = "" Then[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']    Exit Sub[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']End If[/FONT][/COLOR]

[COLOR=#003366][FONT='inherit']Application.EnableEvents = False[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']With Target[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']If .HasFormula = False Then[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']    Select Case Len(.Formula)[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']        Case 4 ' e.g., 9298 = 2-Sep-1998[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']            DateStr = Left(.Formula, 1) & "/" & _ [/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']            Mid(.Formula, 2, 1) & "/" & Right(.Formula, 2)[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']        Case 5 ' e.g., 11298 = 12-Jan-1998 NOT 2-Nov-1998[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']            DateStr = Left(.Formula, 1) & "/" & _ [/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']                Mid(.Formula, 2, 2) & "/" & Right(.Formula, 2)[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']        Case 6 ' e.g., 090298 = 2-Sep-1998[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']            DateStr = Left(.Formula, 2) & "/" & _ [/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']                Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']        Case 7 ' e.g., 1231998 = 23-Jan-1998 NOT 3-Dec-1998[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']            DateStr = Left(.Formula, 1) & "/" & _ [/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']                Mid(.Formula, 2, 2) & "/" & Right(.Formula, 4)[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']        Case 8 ' e.g., 09021998 = 2-Sep-1998[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']            DateStr = Left(.Formula, 2) & "/" & _ [/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']                Mid(.Formula, 3, 2) & "/" & Right(.Formula, 4)[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']        Case Else[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']            Err.Raise 0[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']    End Select[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']    .Formula = DateValue(DateStr)[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']End If[/FONT][/COLOR]

[COLOR=#003366][FONT='inherit']End With[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']Application.EnableEvents = True[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']Exit Sub[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']EndMacro:[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']MsgBox "You did not enter a valid date."[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']Application.EnableEvents = True[/FONT][/COLOR]
[COLOR=#003366][FONT='inherit']End Sub[/FONT][/COLOR]


[CODEPrivate Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim TimeStr As String

On Error GoTo EndMacro
If Application.Intersect(Target, Range("A1:A10")) 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

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 "You did not enter a valid time"
Application.EnableEvents = True
End Sub
][/CODE]
 
Upvote 0
Re: Combining two worksheet events into a single VBA

So if the user enters 1234, how would the code determine if they mean the date Jan 2, 1934 or the time 12:34 ?
 
Upvote 0
Re: Combining two worksheet events into a single VBA

So if the user enters 1234, how would the code determine if they mean the date Jan 2, 1934 or the time 12:34 ?

One event addresses cells that are dates and the other event addresses other cells that are times. I will edit the codes I posted.
 
Upvote 0
Re: Combining two worksheet events into a single VBA

Oops. I see that I cannot edit my first post. Suffice it to say that the ranges will not be the same in the two worksheet events.
 
Upvote 0
Revised: How to combine events in VBA function ?

Sorry for the confusing post earlier. I am trying to combine these two worksheet events. One allows date entry without having to use / and the other allows dates to be entered without the colon. Can someone tell me how to combine them so they run as one. All I can do is run one or the other. Thanks see code below:

Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)Dim TimeStr As String


On Error GoTo EndMacro
If Application.Intersect(Target, Range("C2:D10")) 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


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 "You did not enter a valid time"
Application.EnableEvents = True
End Sub


Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Dim DateStr As String


On Error GoTo EndMacro
If Application.Intersect(Target, Range("B2:B10")) 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


Application.EnableEvents = False
With Target
If .HasFormula = False Then
    Select Case Len(.Formula)
        Case 4 ' e.g., 9298 = 2-Sep-1998
            DateStr = Left(.Formula, 1) & "/" & _
            Mid(.Formula, 2, 1) & "/" & Right(.Formula, 2)
        Case 5 ' e.g., 11298 = 12-Jan-1998 NOT 2-Nov-1998
            DateStr = Left(.Formula, 1) & "/" & _
                Mid(.Formula, 2, 2) & "/" & Right(.Formula, 2)
        Case 6 ' e.g., 090298 = 2-Sep-1998
            DateStr = Left(.Formula, 2) & "/" & _
                Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
        Case 7 ' e.g., 1231998 = 23-Jan-1998 NOT 3-Dec-1998
            DateStr = Left(.Formula, 1) & "/" & _
                Mid(.Formula, 2, 2) & "/" & Right(.Formula, 4)
        Case 8 ' e.g., 09021998 = 2-Sep-1998
            DateStr = Left(.Formula, 2) & "/" & _
                Mid(.Formula, 3, 2) & "/" & Right(.Formula, 4)
        Case Else
            Err.Raise 0
    End Select
    .Formula = DateValue(DateStr)
End If


End With
Application.EnableEvents = True
Exit Sub
EndMacro:
MsgBox "You did not enter a valid date."
Application.EnableEvents = True
End Sub
 
Upvote 0
Hi,
I see you have posted this question 3 times but will answer on the first post.

Try this as an idea

Place in a STANDARD module

Code:
Sub FormatDateOrTime(ByVal Target As Range, ByVal DateOrTime As Integer)
    
    Dim DateStr As String, TimeStr As String
    
    On Error GoTo EndMacro
    
    Application.EnableEvents = False
    With Target
        If .Cells.Count > 1 Or Len(.Value) = 0 Then GoTo EndMacro
        If .HasFormula = False Then
            If DateOrTime = xlDate Then
                Select Case Len(.Formula)
                Case 4 ' e.g., 9298 = 2-Sep-1998
                    DateStr = Left(.Formula, 1) & "/" & _
                    Mid(.Formula, 2, 1) & "/" & Right(.Formula, 2)
                Case 5 ' e.g., 11298 = 12-Jan-1998 NOT 2-Nov-1998
                    DateStr = Left(.Formula, 1) & "/" & _
                    Mid(.Formula, 2, 2) & "/" & Right(.Formula, 2)
                Case 6 ' e.g., 090298 = 2-Sep-1998
                    DateStr = Left(.Formula, 2) & "/" & _
                    Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
                Case 7 ' e.g., 1231998 = 23-Jan-1998 NOT 3-Dec-1998
                    DateStr = Left(.Formula, 1) & "/" & _
                    Mid(.Formula, 2, 2) & "/" & Right(.Formula, 4)
                Case 8 ' e.g., 09021998 = 2-Sep-1998
                    DateStr = Left(.Formula, 2) & "/" & _
                    Mid(.Formula, 3, 2) & "/" & Right(.Formula, 4)
                Case Else
                    Err.Raise 700, , "Invalid Date Entry"
                End Select
                .Formula = DateValue(DateStr)
            Else
'clear cell format
                .NumberFormat = "General"
'remove colon
                .Value = Replace(.Text, ":", "")
'confirm whats left is a number
                If IsNumeric(.Value) 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 600, , "Invalid Time Entry"
                    End Select
'coerce to Time value
                    .Value = TimeValue(TimeStr)
'apply required cell format
                    .NumberFormat = "hh:mm:ss"
                Else
'inform user error
                    Err.Raise 600, , "Invalid Time Entry"
                End If
            End If
        End If
    End With
    
EndMacro:
    Application.EnableEvents = True
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
    
End Sub

I made some changes to the error handling for Time entry as this was not working in manner designed.


Replace the Worksheet_Change event with following update code


Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Const xlTime As Integer = 1
    Dim rng As Range
    
    Set rng = Me.Range("B2:B10,C2:D10")
    
    If Not Application.Intersect(Target, rng) Is Nothing Then
        FormatDateOrTime Target, IIf(Target.Column = rng.Areas(1).Column, xlTime, xlDate)
    End If
    
End Sub


Not sure if it's what you want but hopefully, something you can work with.


Dave
 
Upvote 0
Re: Revised: How to combine events in VBA function ?

Hi Douglas

Use something like

Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim TimeStr As String
Dim DateStr As String

If Not (Application.Intersect(Target, Range("C2:D10")) Is Nothing) Then

' Target is in C2:D10. Code for this range
    
ElseIf Not (Application.Intersect(Target, Range("B2:B10")) Is Nothing) Then
    
' Target is in B2:B10. Code for this range
    
End If

End Sub
 
Upvote 0
Re: Combining two worksheet events into a single VBA

Suffice it to say that the ranges will not be the same in the two worksheet events.

Code:
If Not Application.Intersect(Target, Range([B]"A1:A10"[/B])) Is Nothing Then
    [COLOR=#008000]'Date code[/COLOR]
ElseIf Not Application.Intersect(Target, Range([B]"B1:B10"[/B])) Is Nothing Then
    [COLOR=#008000]'Time code[/COLOR]
End If
 
Last edited:
Upvote 0
Re: Combining two worksheet events into a single VBA

@DouglasK
Please do not post the same question multiple times. All clarifications, follow-ups, and bumps should be posted back to the original thread (rule 12 here: Forum Rules).

I have merged your three threads together
 
Upvote 0

Forum statistics

Threads
1,223,903
Messages
6,175,287
Members
452,631
Latest member
a_potato

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top