Private Sub Worksheet_Change - VBA code merge problem

[rajeshn_in]

Hi friends,

I have added two Private Sub Worksheet_Change codes in to one , but first one is working, second one not working.

Option Explicit
Option Compare Text

Private Sub Worksheet_Change(ByVal Target As Range)

Dim c As Range
Dim r As Excel.Range
Dim xID As Variant
Dim yID As Variant
Dim strErr As String

On Error GoTo Terminate
If Target.Cells.Count > 1 Then GoTo Terminate
If Target.Column = 2 Then

Application.ScreenUpdating = False
yID = Split(Target.Value, ",")

Range("E:FT").EntireColumn.Hidden = True

For Each xID In yID

Select Case Trim(xID)
Case "SHIPPING": Set c = Range("E:Z")
Case "PERMIT": Set c = Range("AA:AK")
Case "INSPECTION": Set c = Range("AL:BA")
Case "COMMISSION": Set c = Range("BB:BR")
Case "INSURANCE": Set c = Range("BS:CB")
Case "CO": Set c = Range("CC:CL")
Case "COURIER": Set c = Range("CM:CV")
Case "BANK CHARGES": Set c = Range("CW:DW")
Case "BUYER": Set c = Range("DX:EZ")
Case "DOCUMENTS": Set c = Range("FA:FT")
Case "ALL LINKS": Set c = Range("E:FT")
End Select

If Not c Is Nothing Then
If r Is Nothing Then
Set r = c
Else
Set r = Union(r, c)
End If
End If

Set c = Nothing

Next

r.EntireColumn.Hidden = False

End If

Terminate:
If Err Then
Debug.Print "ERROR", Err.Number, Err.Description
Err.Clear
ElseIf strErr <> vbNullString Then
MsgBox "The following identifiers were not recognised:" & vbCrLf & vbCrLf & StrConv(strErr, vbUpperCase), vbExclamation, "Input error"
End If

Application.ScreenUpdating = True


Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strVal As String
Dim i As Long
Dim lCount As Long
Dim Ar As Variant
On Error Resume Next
Dim lType As Long
If Target.Count > 1 Then GoTo exitHandler

lType = Target.Validation.Type
If lType = 3 Then
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If Target.Column = 2 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
On Error Resume Next
Ar = Split(oldVal, ", ")
strVal = ""
For i = LBound(Ar) To UBound(Ar)
Debug.Print strVal
Debug.Print CStr(Ar(i))
If newVal = CStr(Ar(i)) Then
'do not include this item
strVal = strVal
lCount = 1
Else
strVal = strVal & CStr(Ar(i)) & ", "
End If
Next i
If lCount > 0 Then
Target.Value = Left(strVal, Len(strVal) - 2)
Else
Target.Value = strVal & newVal
End If
End If
End If
End If
End If

exitHandler:
Application.EnableEvents = True
End Sub

Can any one please advice any changes in code....

code 1: I can choose particular columns one by one or using "," for multiple selection

code 2: I can choose multiple names from dropdown list.

Two codes working well separatly.

 

[charlesdh]

Hi,
I do not think you can have 2 worksheet change event on the same sheet.
You can, however do a "Call" ( code module) for the next code you want to run.

Charles

 

[rajeshn_in]

Hi,
I do not think you can have 2 worksheet change event on the same sheet.
You can, however do a "Call" ( code module) for the next code you want to run.

Charles

Thank you