Worksheet with Multiple Worksheet Changes

[roccoau]

Hi
I have a worksheet which I would like to add 3 different change requests as per below
I get below message so I gather this may not be possible
Does anyone have any tips on how to get around this.
I am only new to Excel code so help much appreciated

Thanks
Rocco

CODE
----------------------------------------------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim v As Variant

If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("C16:C29")) Is Nothing Then Exit Sub 'specific range

'Turn off events to keep out of loops
Application.EnableEvents = False

v = Application.Match(Target.Value, Worksheets("Lists").Range("B:B"), False)

If Not IsError(v) Then
Target.Value = Worksheets("Lists").Range("A:A").Cells(v).Value
End If

'Turn events back on to get ready for the next change
Application.EnableEvents = True
End Sub
----------------------------------------------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim v As Variant

If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("G16:G29")) Is Nothing Then Exit Sub 'specific range

'Turn off events to keep out of loops
Application.EnableEvents = False

v = Application.Match(Target.Value, Worksheets("Lists").Range("F:F"), False)

If Not IsError(v) Then
Target.Value = Worksheets("Lists").Range("E:E").Cells(v).Value
End If

'Turn events back on to get ready for the next change
Application.EnableEvents = True
End Sub
----------------------------------------------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim v As Variant

If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("H16:H29")) Is Nothing Then Exit Sub 'specific range

'Turn off events to keep out of loops
Application.EnableEvents = False

v = Application.Match(Target.Value, Worksheets("Lists").Range("I:I"), False)

If Not IsError(v) Then
Target.Value = Worksheets("Lists").Range("H:H").Cells(v).Value
End If

'Turn events back on to get ready for the next change
Application.EnableEvents = True
End Sub

 

[steve the fish]

You can only have one per worksheet. This should do it:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim v As Variant

If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("C16:C29,G16:G29,H16:H29")) Is Nothing Then Exit Sub 'specific range

'Turn off events to keep out of loops
Application.EnableEvents = False

Select Case Target.Column
    Case 3
        v = Application.Match(Target.Value, Worksheets("Lists").Range("B:B"), False)
        If Not IsError(v) Then Target.Value = Worksheets("Lists").Range("A:A").Cells(v).Value
    Case 7
        v = Application.Match(Target.Value, Worksheets("Lists").Range("F:F"), False)
        If Not IsError(v) Then Target.Value = Worksheets("Lists").Range("E:E").Cells(v).Value
    Case 8
        v = Application.Match(Target.Value, Worksheets("Lists").Range("I:I"), False)
        If Not IsError(v) Then Target.Value = Worksheets("Lists").Range("H:H").Cells(v).Value
End Select

'Turn events back on to get ready for the next change
Application.EnableEvents = True

End Sub

 

[roccoau]

End Sub

Thank you mate that works great much appreciated