Combining Multiple Worksheet_Change Subs VBA

[Chanook89]

I've been trying to combine to separate change events in my VBA code. The first allows users to insert hyperlinks into specific columns and the second enables multi-select drop-downs in other cells.

The problem is I can't get them to work together. One always over rides the other. I've read other threads and have tried to combine my code and am sitting right now with the code below.

Does anyone have any ideas?

Private Sub Worksheet_Change(ByVal Target As Range)


If Selection.Count = 1 Then
        If Not Intersect(Target, Range("AG:AI")) Is Nothing Then
            ActiveSheet.Protect AllowInsertingHyperlinks:=True
        End If
    End If


Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim lUsed As Long
ActiveSheet.Unprotect Password:="IPAC"
'If Selection.Count > 1 Then GoTo exitHandler


On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
'On Error GoTo exitHandler


'If rngDV Is Nothing Then GoTo exitHandler


Select Case Target.Column
Case 18, 20, 23, 27, 29, 44, 46


If Intersect(Target, rngDV) Is Nothing Then
   'do nothing
Else
  Application.EnableEvents = False
  newVal = Target.Value
  Application.Undo
  oldVal = Target.Value
  Target.Value = newVal
If newVal = "" Then
'do nothing
Else
lUsed = InStr(1, oldVal, newVal)
If lUsed > 0 Then
If oldVal = newVal Then
Target.Value = ""
ElseIf Right(oldVal, Len(newVal)) = newVal Then
Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 1)
Else
Target.Value = Replace(oldVal, newVal & vbLf, "")
End If
Else
Target.Value = oldVal & vbLf & newVal
        End If
        
      End If
    End If
  




Case Else:
End Select


ActiveSheet.Protect
exitHandler:
  Application.EnableEvents = True
End Sub

 

[JLGWhiz]

Don't know if this helps or not. I just tried to clean the code up a little.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Dim rngDV As Range, oldVal As String, newVal As String, lUsed As Long
ActiveSheet.Unprotect Password:="IPAC"
Application.EnableEvents = False
On Error GoTo exitHandler:
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
    Select Case Target.Column
        Case 18, 20, 23, 27, 29, 44, 46
            If Not Intersect(Target, rngDV) Is Nothing Then
                newVal = Target.Value
                Application.Undo
                oldVal = Target.Value
                Target.Value = newVal
                    If newVal <> "" Then
                        lUsed = InStr(1, oldVal, newVal)
                            If lUsed > 0 Then
                                If oldVal = newVal Then
                                    Target.Value = ""
                                ElseIf Right(oldVal, Len(newVal)) = newVal Then
                                    Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 1)
                                Else
                                    Target.Value = Replace(oldVal, newVal & vbLf, "")
                                End If
                            Else
                                Target.Value = oldVal & vbLf & newVal
                            End If
                    End If
            End If
    End Select
    If Not Intersect(Target, Range("AG:AI")) Is Nothing Then
            ActiveSheet.Protect AllowInsertingHyperlinks:=True
        End If
ActiveSheet.Protect
exitHandler:
    If Err.Number > 0 Then
        MsgBox Err.Number & ":  " & Err.Description
    End If
  Application.EnableEvents = True
End Sub

 

[Chanook89]

Thanks for cleaning it up. Unfortunately it does the same where only part of it works. In this case the multi-select drop downs work but the addition of hyperlinks does not.

 

[Chanook89]

I Should say I have tried adding it to the on open event but the problem with that is it works once (when you open) and then when the user tries to enter a second hyperlink (they have 3 columns they can insert hyperlinks into) then it doesn't allow them. They can of course save and close and re-open and they can add a second hyperlink but I feel like that is a deterrent to data entry.

 

[JLGWhiz]

Thanks for cleaning it up. Unfortunately it does the same where only part of it works. In this case the multi-select drop downs work but the addition of hyperlinks does not.

Do you mean the user cannot insert a hyperlink after the macro runs? Maybe it is because you have the second 'Protect' line in there. Have you tried an If statement to see if the sheet is protectected, bypass the second Protect statement, If not Protected, then execute the statement?