Combining 2 worksheet change events

[Cammandk]

Hi
I have 2 worksheet events that I need to operate on a worksheet. I soon realised I can't have more than 1 - but I don't know how to combine them.

I've shown the 2 codes below and hopefully included an adequate description of what they do.

Is it possible to combine them. The first was from Narayan on this site and the second was some code from Contextures.


Private Sub Worksheet_Change(ByVal Target As Range)

'This code changes the entry in range F11:F40 from eg "Forecast" to "F"
Application.ScreenUpdating = False
If Application.Intersect(Target, Range("F11:F40")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
Target.Value = Left(Target.Value, 1)
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
' Developed by Contextures Inc.
' www.contextures.com

' This code is for entering a dropdown supplier list in H15:H24. There will eventually be other ranges in "H"
' It allows the user to select from the drop down list or enter a new supplier.
' If a new supplier this gets added to Supplier List which is is sorted in sheet "Lists"

On Error Resume Next
Dim ws As Worksheet
Dim str As String
Dim i As Integer
Dim rngDV As Range
Dim rng As Range

If Target.Count > 1 Then Exit Sub
Set ws = Worksheets("Lists")

If Target.Row > 1 Then
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo 0
If rngDV Is Nothing Then Exit Sub

If Intersect(Target, rngDV) Is Nothing Then Exit Sub

str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
On Error Resume Next
Set rng = ws.Range(str)
On Error GoTo 0
If rng Is Nothing Then Exit Sub

If Application.WorksheetFunction _
.CountIf(rng, Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, rng.Column).End(xlUp).Row + 1
ws.Cells(i, rng.Column).Value = Target.Value
rng.Sort Key1:=ws.Cells(1, rng.Column), _
Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If

End If

End Sub

 

[Hui]

It will be something like:

Private Sub Worksheet_Change(ByVal Target As Range)
 
'This code changes the entry in range F11:F40 from eg "Forecast" to "F"
Application.ScreenUpdating = False
If Application.Intersect(Target, Range("F11:F40")) Is Nothing Then goto Next_Part
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
Target.Value = Left(Target.Value, 1)
Application.EnableEvents = True
Application.ScreenUpdating = True
 
exit sub
 
Next_Part:
' Developed by Contextures Inc.
' [URL='http://www.contextures.com']www.contextures.com[/URL]
 
' This code is for entering a dropdown supplier list in H15:H24. There will eventually be other ranges in "H"
' It allows the user to select from the drop down list or enter a new supplier.
' If a new supplier this gets added to Supplier List which is is sorted in sheet "Lists"
 
On Error Resume Next
Dim ws As Worksheet
Dim str As String
Dim i As Integer
Dim rngDV As Range
Dim rng As Range
 
If Target.Count > 1 Then Exit Sub
Set ws = Worksheets("Lists")
 
If Target.Row > 1 Then
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo 0
If rngDV Is Nothing Then Exit Sub
 
If Intersect(Target, rngDV) Is Nothing Then Exit Sub
 
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
On Error Resume Next
Set rng = ws.Range(str)
On Error GoTo 0
If rng Is Nothing Then Exit Sub
 
If Application.WorksheetFunction _
.CountIf(rng, Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, rng.Column).End(xlUp).Row + 1
ws.Cells(i, rng.Column).Value = Target.Value
rng.Sort Key1:=ws.Cells(1, rng.Column), _
Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
 
End If
 
End Sub