Combining two VBA Codes Change (ByVal Target) and (ByVal Destination)

OscarMDMBA

New Member
Joined
Sep 7, 2023
Messages
6
Office Version
  1. 365
Platform
  1. Windows
Hi, been referencing Mr Excel for years now but first time actually posting a question.
I have two codes that both work independently. One is a Change (ByVal Target) the other is a Change (ByVal Destination)
I need both codes to work on the same worksheet but trigger only for different specific cells.
I know I can't have two Change (ByVal....) codes on a worksheet but not sure how to combine these two.
First code allows me to multiselect from a pulldown in a specific cell.
Second code allows me to hide certain rows depending on the value selected in another pulldown in another cell.
Any help would be greatly appreciated!
I've pasted both codes below.

First code
Private Sub Worksheet_Change(ByVal Destination As Range)
Dim rngDropdown As Range
Dim oldValue As String
Dim newValue As String
Dim DelimiterType As String
DelimiterType = ", "
Dim DelimiterCount As Integer
Dim TargetType As Integer
Dim i As Integer
Dim arr() As String

If Destination.Count > 1 Then Exit Sub
On Error Resume Next

Set rngDropdown = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitError

If rngDropdown Is Nothing Then GoTo exitError
If Destination.Address <> "$F$2" Then GoTo exitError

TargetType = 0
TargetType = Destination.Validation.Type
If TargetType = 3 Then ' is validation type is "list"
Application.ScreenUpdating = False
Application.EnableEvents = False
newValue = Destination.Value
Application.Undo
oldValue = Destination.Value
Destination.Value = newValue
If oldValue <> "" Then
If newValue <> "" Then
If oldValue = newValue Or oldValue = newValue & Replace(DelimiterType, " ", "") Or oldValue = newValue & DelimiterType Then ' leave the value if there is only one in the list
oldValue = Replace(oldValue, DelimiterType, "")
oldValue = Replace(oldValue, Replace(DelimiterType, " ", ""), "")
Destination.Value = oldValue
ElseIf InStr(1, oldValue, DelimiterType & newValue) Or InStr(1, oldValue, " " & newValue & DelimiterType) Then
arr = Split(oldValue, DelimiterType)
If Not IsError(Application.Match(newValue, arr, 0)) = 0 Then
Destination.Value = oldValue & DelimiterType & newValue
Else:
Destination.Value = ""
For i = 0 To UBound(arr)
If arr(i) <> newValue Then
Destination.Value = Destination.Value & arr(i) & DelimiterType
End If
Next i
Destination.Value = Left(Destination.Value, Len(Destination.Value) - Len(DelimiterType))
End If
ElseIf InStr(1, oldValue, newValue & Replace(DelimiterType, " ", "")) Then
oldValue = Replace(oldValue, newValue, "")
Destination.Value = oldValue
Else
Destination.Value = oldValue & DelimiterType & newValue
End If
Destination.Value = Replace(Destination.Value, Replace(DelimiterType, " ", "") & Replace(DelimiterType, " ", ""), Replace(DelimiterType, " ", "")) ' remove extra commas and spaces
Destination.Value = Replace(Destination.Value, DelimiterType & Replace(DelimiterType, " ", ""), Replace(DelimiterType, " ", ""))
If Destination.Value <> "" Then
If Right(Destination.Value, 2) = DelimiterType Then ' remove delimiter at the end
Destination.Value = Left(Destination.Value, Len(Destination.Value) - 2)
End If
End If
If InStr(1, Destination.Value, DelimiterType) = 1 Then ' remove delimiter as first characters
Destination.Value = Replace(Destination.Value, DelimiterType, "", 1, 1)
End If
If InStr(1, Destination.Value, Replace(DelimiterType, " ", "")) = 1 Then
Destination.Value = Replace(Destination.Value, Replace(DelimiterType, " ", ""), "", 1, 1)
End If
DelimiterCount = 0
For i = 1 To Len(Destination.Value)
If InStr(i, Destination.Value, Replace(DelimiterType, " ", "")) Then
DelimiterCount = DelimiterCount + 1
End If
Next i
If DelimiterCount = 1 Then ' remove delimiter if last character
Destination.Value = Replace(Destination.Value, DelimiterType, "")
Destination.Value = Replace(Destination.Value, Replace(DelimiterType, " ", ""), "")
End If
End If
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End If

exitError:
Application.EnableEvents = True

End Sub

SECOND CODE
Private Sub Worksheet_Change(ByVal Target As Range)
' Has the cell with the dropdown changed?
If Not Intersect(Range("AE2"), Target) Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False
' Unhide all rows in the relevant range
Range("A3:A284").EntireRow.Hidden = False
' Inspect the value of the dropdown
Select Case Range("AE2").Value
Case ""
Range("A3:A284").EntireRow.Hidden = True
Case "1 image/screen"
Range("A23:A284").EntireRow.Hidden = True
Case "2 images/screen (1 down x 2 across)"
Range("A5:A22").EntireRow.Hidden = True
Range("A41:A284").EntireRow.Hidden = True
Case "2 images/screen (2 down x 1 across)"
Range("A5:A40").EntireRow.Hidden = True
Range("A59:A284").EntireRow.Hidden = True
End Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub
 
Never mind, just realized that passing variables through to create multiple dropdowns cases won't work given how I have created my dependent dropdowns.
Appreciate all the timely input. I have both my codes working on the same sheet and firing appropriately based on the selections of the two different pulldowns in question.
Can't thank you all enough!
I am posting my final working solution below in case someone else wants to see it.
VBA Code:
Private Sub Worksheet_Change(ByVal Destination As Range)
    Dim rngDropdown As Range
    Dim oldValue As String
    Dim newValue As String
    Dim DelimiterType As String
    DelimiterType = ", "
    Dim DelimiterCount As Integer
    Dim TargetType As Integer
    Dim i As Integer
    Dim arr() As String

    If Destination.Count > 1 Then Exit Sub
    On Error Resume Next
  

    Set rngDropdown = Cells.SpecialCells(xlCellTypeAllValidation)
    On Error GoTo exitError

    If rngDropdown Is Nothing Then GoTo exitError
  
    If Not Intersect(Destination, Range("F2")) Is Nothing Then
    TargetType = 0
    TargetType = Destination.Validation.Type
    If TargetType = 3 Then  ' is validation type is "list"
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        newValue = Destination.Value
        Application.Undo
        oldValue = Destination.Value
        Destination.Value = newValue
        If oldValue <> "" Then
            If newValue <> "" Then
                If oldValue = newValue Or oldValue = newValue & Replace(DelimiterType, " ", "") Or oldValue = newValue & DelimiterType Then ' leave the value if there is only one in the list
                    oldValue = Replace(oldValue, DelimiterType, "")
                    oldValue = Replace(oldValue, Replace(DelimiterType, " ", ""), "")
                    Destination.Value = oldValue
                ElseIf InStr(1, oldValue, DelimiterType & newValue) Or InStr(1, oldValue, " " & newValue & DelimiterType) Then
                    arr = Split(oldValue, DelimiterType)
                If Not IsError(Application.Match(newValue, arr, 0)) = 0 Then
                    Destination.Value = oldValue & DelimiterType & newValue
                        Else:
                    Destination.Value = ""
                    For i = 0 To UBound(arr)
                    If arr(i) <> newValue Then
                        Destination.Value = Destination.Value & arr(i) & DelimiterType
                    End If
                    Next i
                Destination.Value = Left(Destination.Value, Len(Destination.Value) - Len(DelimiterType))
                End If
                ElseIf InStr(1, oldValue, newValue & Replace(DelimiterType, " ", "")) Then
                    oldValue = Replace(oldValue, newValue, "")
                    Destination.Value = oldValue
                Else
                    Destination.Value = oldValue & DelimiterType & newValue
                End If
                Destination.Value = Replace(Destination.Value, Replace(DelimiterType, " ", "") & Replace(DelimiterType, " ", ""), Replace(DelimiterType, " ", "")) ' remove extra commas and spaces
                Destination.Value = Replace(Destination.Value, DelimiterType & Replace(DelimiterType, " ", ""), Replace(DelimiterType, " ", ""))
                If Destination.Value <> "" Then
                    If Right(Destination.Value, 2) = DelimiterType Then  ' remove delimiter at the end
                        Destination.Value = Left(Destination.Value, Len(Destination.Value) - 2)
                    End If
                End If
                If InStr(1, Destination.Value, DelimiterType) = 1 Then ' remove delimiter as first characters
                    Destination.Value = Replace(Destination.Value, DelimiterType, "", 1, 1)
                End If
                If InStr(1, Destination.Value, Replace(DelimiterType, " ", "")) = 1 Then
                    Destination.Value = Replace(Destination.Value, Replace(DelimiterType, " ", ""), "", 1, 1)
                End If
                DelimiterCount = 0
                For i = 1 To Len(Destination.Value)
                    If InStr(i, Destination.Value, Replace(DelimiterType, " ", "")) Then
                        DelimiterCount = DelimiterCount + 1
                    End If
                Next i
                If DelimiterCount = 1 Then ' remove delimiter if last character
                    Destination.Value = Replace(Destination.Value, DelimiterType, "")
                    Destination.Value = Replace(Destination.Value, Replace(DelimiterType, " ", ""), "")
                End If
            End If
        End If
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End If
        If Not Intersect(Destination, Range("AE2")) Is Nothing Then
            Range("A3:A284").EntireRow.Hidden = False
            Select Case Destination
            Case Is = "image(s)/monitor"
                Range("A3:A284").EntireRow.Hidden = True
            Case Is = "1 image/monitor"
                Range("A23:A284").EntireRow.Hidden = True
            Case Is = "2 images/monitor (1 down x 2 across)"
                Range("A5:A22").EntireRow.Hidden = True
                Range("A41:A284").EntireRow.Hidden = True
            Case Is = "2 images/monitor (2 down x 1 across)"
                Range("A5:A40").EntireRow.Hidden = True
                Range("A59:A284").EntireRow.Hidden = True
            Case Is = "3 images/monitor (1 down x 3 across)"
                Range("A5:A58").EntireRow.Hidden = True
                Range("A77:A284").EntireRow.Hidden = True
            Case Is = "3 images/monitor (3 down x 1 across)"
                Range("A5:A76").EntireRow.Hidden = True
                Range("A95:A284").EntireRow.Hidden = True
            Case Is = "4 images/monitor (1 down x 4 across)"
                Range("A5:A94").EntireRow.Hidden = True
                Range("A113:A284").EntireRow.Hidden = True
            Case Is = "4 images/monitor (2 down x 2 across)"
                Range("A5:A112").EntireRow.Hidden = True
                Range("A131:A284").EntireRow.Hidden = True
            Case Is = "4 images/monitor (4 down x 1 across)"
                Range("A5:A130").EntireRow.Hidden = True
                Range("A147:A284").EntireRow.Hidden = True
            Case Is = "6 images/monitor (2 down x 3 across)"
                Range("A5:A146").EntireRow.Hidden = True
                Range("A165:A284").EntireRow.Hidden = True
            Case Is = "6 images/monitor (3 down x 2 across)"
                Range("A5:A164").EntireRow.Hidden = True
                Range("A183:A284").EntireRow.Hidden = True
            Case Is = "8 images/monitor (2 down x 4 across)"
                Range("A5:A182").EntireRow.Hidden = True
                Range("A201:A284").EntireRow.Hidden = True
            Case Is = "8 images/monitor (4 down x 2 across)"
                Range("A5:A200").EntireRow.Hidden = True
                Range("A217:A284").EntireRow.Hidden = True
            Case Is = "9 images/monitor (3 down x 3 across)"
                Range("A5:A216").EntireRow.Hidden = True
                Range("A235:A284").EntireRow.Hidden = True
            Case Is = "12 images/monitor (3 down x 4 across)"
                Range("A5:A234").EntireRow.Hidden = True
                Range("A253:A284").EntireRow.Hidden = True
            Case Is = "12 images/monitor (4 down x 3 across)"
                Range("A5:A252").EntireRow.Hidden = True
                Range("A269:A284").EntireRow.Hidden = True
            Case Is = "16 images/monitor (4 down x 4 across)"
                Range("A5:A268").EntireRow.Hidden = True
        End Select
    End If
      
exitError:
          Application.EnableEvents = True
 
End Sub
 
Upvote 0
Solution

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

Forum statistics

Threads
1,224,811
Messages
6,181,081
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top