• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

combine 2 worksheet_change events on one tab

Rodger

Member
Hi all,

I hope this is simple enough, but I cant seem to get it to work, any help would be awesome.

I would like the attached 2 codes to work together on the same tab, each work individually just fine, but I cant seem to combine them.

Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim rCell As Range
    Dim rChange As Range
   
    On Error GoTo ErrHandler
    Set rChange = Intersect(Target, Range("I:I"))
    If Not rChange Is Nothing Then
        Application.EnableEvents = False
        For Each rCell In rChange
            If rCell > "" Then
                With rCell.Offset(0, 10)
                    .Value = Now
                    .NumberFormat = "dd/mm/yyyy h:mm AM/PM"
                End With
            Else
                rCell.Offset(0, 10).Clear
            End If
        Next
    End If

ExitHandler:
    Set rCell = Nothing
    Set rChange = Nothing
    Application.EnableEvents = True
    Exit Sub
ErrHandler:
   
    Resume ExitHandler
End Sub


and


Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Whoa

    Application.EnableEvents = False

    If Not Target.Cells.CountLarge > 1 Then
        If Not Intersect(Target, Columns(2)) Is Nothing Then
            Target.Offset(, 2).Select
        ElseIf Not Intersect(Target, Columns(4)) Is Nothing Then
            Target.Offset(, 1).Select
        ElseIf Not Intersect(Target, Columns(5)) Is Nothing Then
            Target.Offset(, 1).Select
        ElseIf Not Intersect(Target, Columns(6)) Is Nothing Then
            Target.Offset(1, -4).Select
        End If
    End If
Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

any thoughts?

Rodger
 
Hi:

May be this
Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim rCell As Range
    Dim rChange As Range

    On Error GoTo ErrHandler
    Set rChange = Intersect(Target, Range("I:I"))
    If Not rChange Is Nothing Then
        Application.EnableEvents = False
        For Each rCell In rChange
            If rCell > "" Then
                With rCell.Offset(0, 10)
                    .Value = Now
                    .NumberFormat = "dd/mm/yyyy h:mm AM/PM"
                End With
            Else
                rCell.Offset(0, 10).Clear
            End If
        Next
    End If

ExitHandler:
    Set rCell = Nothing
    Set rChange = Nothing
    Application.EnableEvents = True
    Exit Sub
ErrHandler:

    Resume ExitHandler
test
End Sub

Sub test
    On Error GoTo Whoa

    Application.EnableEvents = False

    If Not Target.Cells.CountLarge > 1 Then
        If Not Intersect(Target, Columns(2)) Is Nothing Then
            Target.Offset(, 2).Select
        ElseIf Not Intersect(Target, Columns(4)) Is Nothing Then
            Target.Offset(, 1).Select
        ElseIf Not Intersect(Target, Columns(5)) Is Nothing Then
            Target.Offset(, 1).Select
        ElseIf Not Intersect(Target, Columns(6)) Is Nothing Then
            Target.Offset(1, -4).Select
        End If
    End If
Letscontinue:
    Application.EnableEvents = True
    Exit Sub

Thanks
 
Hi:

I have not done any changes to your code, I just changed the name of your second Worksheet_Change event to "test" and called that macro in your first Worksheet_Change event. Test if your code is running separately.

Thanks
 
Hi,

I just tried the second code on its own, as pasted in my OP, and it works perfect.
When I put your suggested code in, as I say, the first part works, but it's as if the second part isn't there.

Rodger
 
here is the tab I am working with. The one event is to timestamp the entry, and the second is for cursor movement right.

I appreciate you looking at this ! thanks.
 

Attachments

Your second macro was incomplete, use the following code for second macro.
Code:
Sub test()
    On Error GoTo Whoa

    Application.EnableEvents = False

    If Not Target.Cells.CountLarge > 1 Then
        If Not Intersect(Target, Columns(2)) Is Nothing Then
            Target.Offset(, 2).Select
        ElseIf Not Intersect(Target, Columns(4)) Is Nothing Then
            Target.Offset(, 1).Select
        ElseIf Not Intersect(Target, Columns(5)) Is Nothing Then
            Target.Offset(, 1).Select
        ElseIf Not Intersect(Target, Columns(6)) Is Nothing Then
            Target.Offset(1, -4).Select
        End If
    End If
Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

Thanks
 
Hi again,
That was a cut and paste error, I have re-attached the file, if you care to look again. It still doesnt fire the second code. If you remove the first, the cursor movement is correct.

Rodger
 

Attachments

Back
Top