Cannot get 2 worksheet change macros combined?

[Ace71425]

Hello for the life of me I cannot get these 2 worksheet change events combined. Below is the code of me just pasting one after the other in the same sub. They work seperately but the bottom one doesnt work when they're combined. Thank you.

Private Sub Worksheet_Change(ByVal TARGET As Range)
    Dim A As Range, B As Range, Inte As Range, r As Range, sReason As Variant
    Set A = Range("C:C")
    Set Inte = Intersect(A, TARGET)
    If Inte Is Nothing Then Exit Sub
    Application.EnableEvents = False
        For Each r In Inte
            r.Offset(0, -1).Value = Date
        Next r
    Application.EnableEvents = True
    If TARGET.Cells.Count > 1 Then Exit Sub
     
    Application.ScreenUpdating = False
    
 **THIS IS WHERE SECOND MACRO BEGINS**** 
 If Not Intersect(TARGET, Range("D1:D500")) Is Nothing Then
    sReason = ""
    If TARGET.Value = "MISC" Then
        While sReason = ""
            sReason = Application.InputBox("Reason for MISC?", Type:=2)
            If sReason = False Then
                TARGET.ClearContents
            Else
                TARGET.Offset(0, 14) = sReason
            End If
        Wend
    End If
End If
     
    Application.ScreenUpdating = True
    
End Sub

 

[Mike LH]

Hi,

Try it this way.

Private Sub Worksheet_Change(ByVal TARGET As Range)
    Dim A As Range, B As Range, Inte As Range, r As Range, sReason As Variant
    Set A = Range("C:C")
    Set Inte = Intersect(A, TARGET)
    If Not Inte Is Nothing Then
    Application.EnableEvents = False
        For Each r In Inte
            r.Offset(0, -1).Value = Date
        Next r
    Application.EnableEvents = True
    If TARGET.Cells.Count > 1 Then Exit Sub
     
    Application.ScreenUpdating = False
    End If
 '**THIS IS WHERE SECOND MACRO BEGINS****
 If Not Intersect(TARGET, Range("D1:D500")) Is Nothing Then
    sReason = ""
    If UCase(TARGET.Value) = "MISC" Then
        While sReason = ""
            sReason = Application.InputBox("Reason for MISC?", Type:=2)
            If sReason = False Then
                TARGET.ClearContents
            Else
                TARGET.Offset(0, 14) = sReason
            End If
        Wend
    End If
End If
     
    Application.ScreenUpdating = True
    
End Sub

 

[Ace71425]

Neither Macro is working

 

[Mike LH]

Hi,

They both work fine for me. You may have disabled events while altering the macro. Paste this snippet of code in and run it

Sub ss()
Application.EnableEvents = True
End Sub