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

O

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
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Sort by date Sort by votes
Unfortunately you didn't post your code within code tags (vba button on posting toolbar) to maintain indentation and readability. I don't know about anyone else but there's no way I'm going to try to make sense out of it when it's all left justified. Have to admit though, I didn't know of the Destination syntax. Either way, the same value is contained in the Target or Destination property, so why have both?

If you need 2 similar procedures on one sheet, one possible approach is to use module level code that does all the work. You'd pass to that procedure whatever parameters make sense based on what's going on in the calling code. I can't be more specific than that since I can't bring myself to read what you've got. It's not a spiteful thing - it's just that honestly, my old brain can't follow it that way.
 
Upvote 0
Sorry, Micron. That was a newbie poster fail on my part. While waiting for a response to my post I found a potential solution on another thread in MrExcel and tried to implement it.
The first part of the code that lets me select multiple dropdown items for a dropdown at F2 works but the second part of the code designed to hide rows based on the value in the dropdown at AE2 seems to exit out without working. Thoughts?
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 Destination.Address <> "$F$2" Or Destination.Address <> "$AE$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
    
If Not Intersect(Destination, Range("AE2")) Is Nothing Then
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Range("A3:A284").EntireRow.Hidden = False
    Select Case Destination

            Case Is = ""
                Range("A3:A284").EntireRow.Hidden = True
            Case Is = "1 image/screen"
                Range("A23:A284").EntireRow.Hidden = True
            Case Is = "2 images/screen (1 down x 2 across)"
                Range("A5:A22").EntireRow.Hidden = True
                Range("A41:A284").EntireRow.Hidden = True
            Case Is = "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

exitError:
  Application.EnableEvents = True

  End Sub
 
Upvote 0
May not get back to this until tomorrow. I'm the chief cook and bottle washer; was prepping for dinner and what does wife do? Invites 2 more. I have 3 chicken breasts thawed so I have another challenge that will keep me busy for a while. 😖
 
Upvote 0
LOL...nice to meet a fellow chief cook and bottle washer - been there done that! I would just butterfly the breast and voila! 3 breasts can feed 6 (just add extra rice/veggies/beans to the plate) ;)
Appreciate you taking the time to help me when you can.
 
Upvote 0
If I understand you correctly, you want 2 separate codes to run depending on whether F2 or AE2 is changed? If that's correct, I would normally do something like the following (try it on a copy of your workbook). If I totally misunderstood your aim, then please ignore.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge = 1 And Not Intersect(Range("F2,AE2"), Target) Is Nothing Then
    On Error GoTo Escape
    Application.EnableEvents = False
    
    If Target.Address = "$F$2" Then
        'All your code relating to F2 being changed
    End If
    If Target.Address = "$AE$2" Then
        'All your code relating to AE2 being changed
    End If
    
    End If
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub
 
Upvote 0
Thanks for the response, kevin9999!
I took your code and added all the code relating to F2 and AE2 based on your comments in the code (see below)
Trying to select something from either dropdown lists gives a Run-time error '424' Object required.
When I debug it highlights:
VBA Code: 
If Target.Cells.CountLarge = 1 And Not Intersect(Range("F2,AE2"), Target) Is Nothing Then

Here is the entire code in question:
VBA Code: 
Private Sub Worksheet_Change(ByVal Destination As Range)
If Target.Cells.CountLarge = 1 And Not Intersect(Range("F2,AE2"), Target) Is Nothing Then
On Error GoTo Escape
Application.EnableEvents = False
    
If Target.Address = "$F$2" Then
    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
End If
    If Target.Address = "$AE$2" Then
        If Not Intersect(Destination, Range("AE2")) Is Nothing Then
            Application.ScreenUpdating = False
            Application.EnableEvents = False
            Range("A3:A284").EntireRow.Hidden = False
            Select Case Destination
        
                    Case Is = ""
                        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
                End Select
                Application.EnableEvents = True
                Application.ScreenUpdating = True
            End If
        
exitError:
          Application.EnableEvents = True
  
    End If
    
    End If
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub
 
Upvote 0
Try replacing that line with:
VBA Code: 
If Target.Cells.CountLarge = 1 Then
 
Upvote 0
@kevin9999
I think the OP is confused because he's trying to use both "Target" & "Destination" as variable.
OscarMDMBA said:
I have two codes that both work independently. One is a Change (ByVal Target) the other is a Change (ByVal Destination)
Click to expand...
Private Sub Worksheet_Change(ByVal Destination As Range)
If Target.Cells.CountLarge = 1 And Not Intersect(Range("F2,AE2"), Target) Is Nothing Then
Click to expand...
 
Upvote 0
I appreciate all the input and have used it to successfully each code on the same page triggered by changes in two different pulldowns. (see code below).
The second part of my question is how could I tweak the code below so that I can duplicate these dropdowns and their associated function on the same worksheet up to 20 times without having to hardcode it 19 additional times.

I currently have the 2 dropdowns in row 2 (F2 and AE2). Below that I have 282 rows that are selectively hidden/unhidden by the code (last row on sheet is 284).
I'd like to have duplicate dropdowns in row 285 (F285 and AE285), row 568, row 851, etc.

Appreciate any ideas to do this as efficiently as possible.

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
You must log in or register to reply here.

Similar threads

E
  • Question Question
Can you combine these 2 macros ?
Replies
6
Views
186
excel4us
E
welshraz
  • Question Question
VBA - Restrict Code to One Column for Multi-choice Dropdown
Replies
2
Views
70
welshraz
welshraz
J
  • Question Question
Multiple select validation list VBA
Replies
1
Views
212
jkpieterse
jkpieterse
M
  • Question Question
Help making my VBA code apply to only one column
Replies
2
Views
538
Alex Blakenburg
A
K
  • Solved
Combining 3 Worksheet_Change events
Replies
4
Views
527
Kevo
K

Forum statistics

Threads
1,223,707
Messages
6,174,000
Members
452,542
Latest member
Bricklin

Share this page

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