How to activate two Option Explicit Private Sub Worksheet_Change(ByVal Target As Range)

[K0st4din]

Hello everyone, I would like to ask for your assistance.
I have two macros which are:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
the two macros do completely different things in the excel workbook.
I am asking for your help on how to make both of them work, each for himself.
Thank you in advance.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect "k0st4d"
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.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

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 Target.Column = 3 Then
    If oldVal = "" Then
      'do nothing
      Else
      If newVal = "" Then
      'do nothing
      Else
      Target.Value = oldVal _
        & ", " & newVal
      End If
    End If
  End If
End If

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

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
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("Base")

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

 

[Joe4]

You are not allowed to have multiple procedures with the same name in the same module.
But all you have to do is to stack the two bodies of code together in the same procedure, like this:

Private Sub Worksheet_Change(ByVal Target As Range)


'*****FIRST PROCEDURE*****
ActiveSheet.Unprotect "k0st4d"
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.CountLarge > 1 Then GoTo exitHandler

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

If rngDV Is Nothing Then GoTo exitHandler

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 Target.Column = 3 Then
    If oldVal = "" Then
      'do nothing
      Else
      If newVal = "" Then
      'do nothing
      Else
      Target.Value = oldVal _
        & ", " & newVal
      End If
    End If
  End If
End If

exitHandler:
  Application.EnableEvents = True
  ActiveSheet.Protect "k0st4d"


'*****SECOND PROCEDURE*****
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.CountLarge > 1 Then Exit Sub
Set ws = Worksheets("Base")

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

 

[K0st4din]

Hello, thank you very much for the quick response, but apparently there is some dubbing in the two macros that prevents them from working together
I tried this rngDV changing its name to something else (rAngDV) in FIRST PROCEDURE, for example, so that they are not the same, but again it told me that there was this error.
Can it be fixed?
Thanks again!

 

[K0st4din]

Hello again, I'm very sorry, I forgot to change this rngDV, in one place, just in the 4 places where it was there, I changed it to rangDV and now everything works as it should (hope I didn't do something wrong).
Thank you very much and stay alive and well!
Thank you very much!
Best regards