Multiple Macros on One worksheet

Question

Greetings,

I am trying to run these two macros on the same worksheet.  I have been all over the forums and on other sites and cannot for the life of me get it work. 

Here is what I am trying to do.  I have one column where I need to have multiple items selected on a drop down list.  This one works even with the other macro pasted in there.

The second thing I am trying to do is to make dependent drop down lists.  One column labled "Outcomes"  and then Outcome reasons, so I want to be able to select one type of outcome and then the outcome reason specific to that outcome.

Also, I need to be able to run the macro in several lines, as I am tracking information.  The first macro looks great on the first line, but when I go down to complete the second line in the spreadsheet the multiple items no longer work.

Thank you in advance!

First Macro

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim oldVal As String

    Dim newVal As String

    If Target.Address(0, 0) <> "F2" Then Exit Sub

    On Error GoTo ReEnable

    Application.EnableEvents = False

    newVal = Target.Value

    Application.Undo

    oldVal = Target.Value

    Target.Value = newVal

    If oldVal <> "" And newVal <> "" Then

        Target.Value = oldVal & ", " & newVal

    End If

ReEnable:

    Application.EnableEvents = True

Second Macro

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

    If Not Intersect(Target, Range("N2:N1000")) Is Nothing Then

        Range(Cells(Target.Row, "O"), Cells(Target.Row, "Q")).Value = ""

    ElseIf Not Intersect(Target, Range("O2:O1000")) Is Nothing Then

        Range(Cells(Target.Row, "P"), Cells(Target.Row, "Q")).Value = ""

    ElseIf Not Intersect(Target, Range("P2:P1000")) Is Nothing Then

        Cells(Target.Row, "Q").Value = ""

    End If

Application.EnableEvents = True

End Sub

Answer 1

Hi,

try and this....

Private Sub Worksheet_Change(ByVal Target As Range)

'Nov 01, 2014

Dim oldVal As String

Dim newVal As String

If Not Intersect(Target, [F2]) Is Nothing Then

On Error GoTo ReEnable

Application.EnableEvents = False

newVal = Target.Value

Application.Undo

oldVal = Target.Value

Target.Value = newVal

If oldVal <> "" And newVal <> "" Then Target.Value = oldVal & ", " & newVal

ReEnable:

Application.EnableEvents = True

End If

If Not Intersect(Target, Range("N2:N1000")) Is Nothing And Target.Count = 1 Then Cells(Target.Row, "O").Resize(, 3).ClearContents

If Not Intersect(Target, Range("O2:O1000")) Is Nothing And Target.Count = 1 Then Cells(Target.Row, "P").Resize(, 2).ClearContents

If Not Intersect(Target, Range("P2:P1000")) Is Nothing And Target.Count = 1 Then Cells(Target.Row, "Q").ClearContents

End Sub

Answer 2

Hello jelac07,

You cannot have multiple subs with the same name within the same module because you will get an ambiguous name error. The following example might help you to achieve your aims by using the Select Case to determine what column or cell has been changed.

Note that I have used variables to save the row and column because I believe it is easier than constantly writing Target.Row or Target.Column. Also you can sometimes combine code by using this method.

I am guessing that you have used the range from row 2 to row 1000 because row 1000 will always be below your range of data so I have simply tested for the change in row 1 (the column header row) and exit if that is where the change is made and then can simply test for the entire column for the rest of the code.

The case statements simply return True of False. Similar to If/Then but you do not use the If and Then; it is simply a statement that returns a True or False falue.

Feel free to get back to me if any questions on this method.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim lngRow As Long

    Dim lngCol As Long

    Dim oldVal As String

    Dim newVal As String

    lngRow = Target.Row             'Assign row number to a variable

    If lngRow = 1 Then Exit Sub     'Don't process if change is in header row

    lngCol = Target.Column          'Assign column number to a variable

    On Error GoTo ReEnable

    Application.EnableEvents = False

    Select Case True

        Case lngCol = 6    'Column F

            MsgBox "Column F identified"

            'place code here in lieu of MsgBox to process change in column F

        Case lngCol = 14     'Column N

            MsgBox "Column N identified"

            'place code here in lieu of MsgBox to process change in column N

        Case lngCol = 15     'Column O

            MsgBox "Column O identified"

            'place code here in lieu of MsgBox to process change in column O

        Case lngCol = 16     'Column P

            MsgBox "Column P identified"

            'place code here in lieu of MsgBox  to process change in column P

        'Following code to demonstrate other methods of returning True Target

        Case Not Intersect(Target, Range("T2:X20")) Is Nothing

            MsgBox "Identified within  RangeT2:X20"

        Case lngCol = 17 And lngRow = 5         'Can use And/Or in the statement

            MsgBox "Identified column 17 and row 5"

        Case Target.Address = "$A$2"

            MsgBox "Cell $A$2 identified using absolute"

        Case Target.Address(0, 0) = "A3"

            MsgBox "Cell A3 identified"

    End Select

ReEnable:

    If Err.Number <> 0 Then

        MsgBox "Error occured in Private Sub Worksheet_Change" & vbCrLf & _

                "Please advise the application administrator."

    End If

    Application.EnableEvents = True

End Sub