Please help me combine these worksheet events

G

GranvilleDouglas

New member
Joined
Jan 19, 2019
Messages
1
Reaction score
0
Points
0
Excel Version(s)
2016
Hello. I am a complete novice at programming and this is a big ask. Can someone combine the following events into a single VBA function for me to cut and paste into an Excel worksheet? The first one allows me to enter time data in cells C2-D10 without having to use the colon ":". The second code allows me to enter calendar dates in cells B2-B10 without having to enter the "/" between the month and day or the day and year. Both of these make data entry easier and faster. I found both of these code sets on an excel website so please understand that I don't know how they work. All I know is that I can cut and paste either one of them into my worksheet and each one works by itself. What I cannot figure out is how to combine them so they both operate at the same time! So if someone would have mercy on me and be kind enough to do it for me I would appreciate it. What I am hoping for is code that I can simply cut and paste. Thanks! PS - I am am psychologist and this is a worksheet that I use many times a day to record psychological testing time.


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


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("B2:B10")) 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]
 
try this
Code: 
Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    Dim DateStr As String
    Dim TimeStr As String

If Target.Cells.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub

On Error GoTo EndMacro

' DATE
If Not Application.Intersect(Target, Range("B2:B10")) Is Nothing Then
    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
                    MsgBox "You did not enter a valid date."
                    .Select ' go back to that cell
                    Exit Sub
            End Select
            ' write in the date
            Application.EnableEvents = False
            .Formula = DateValue(DateStr)
            Application.EnableEvents = True
        End If
    End With
End If

' TIME
If Not Application.Intersect(Target, Range("C2:D10")) Is Nothing Then
    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
                    MsgBox "You did not enter a valid time"
                    .Select ' go back to that cell
                    Exit Sub
            End Select
            ' write in the time
            Application.EnableEvents = False
            .Value = TimeValue(TimeStr)
            Application.EnableEvents = True
        End If
    End With
End If
Exit Sub

EndMacro:
    MsgBox "Some kind of error has occurred."
    Application.EnableEvents = True
End Sub
 
You must log in or register to reply here.
Back
Top