Combine two Worksheet_Change in one Makro - VBA

[Nadine1988]

Hello,

I'm really new to the VBA world and I'm currently trying to create a form which can be filled out. I got pretty far already but now I'm stuck. the problem is that I don't know how to combine two makro's under one Worksheet_Change.
So i do have this existing makro which is working perfectly fine:

'Mehrfachselektion mit Löschfunktion

Option Explicit
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 = vbCrLf
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 <> "$C$41" And Destination.Address <> "$D$41" And Destination.Address <> "$C$51" And Destination.Address <> "$D$51" 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) 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


What I now need is to add a makro which does the following: When "No" is choosen in the dorpdown in cell D43, rows 45 - 55 needs to be hidden. If "Yes" is choosen in the dropdown the rows needs to be shown. I don't know where to add the makro in above code... Looking forward to your help

Thanks
Nadin

 

[Herakles]

This code will give you the idea.

I have added in an IF statement covering cell D43 which has a validation list in it.

Try to indent you code and include blank lines to seperate sections.

The Quick-wrap selection as VBA code icon on the Mr Excel ribbon can be used to post VBA code.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Count > 1 Then
        Exit Sub
    End If

    If Target = Range("$D$43") Then
        ActiveSheet.Rows("45:55").EntireRow.Hidden = Target.Value = "No"
        Exit Sub
    End If
    
    If Target = Range("A10") Then
        ' Add code in here if the value in cell A10 changes.
        Exit Sub
    End If
    
    If Target = Range("D10") Then
        ' Add code in here if the value in cell D10 changes.
        Exit Sub
    End If
 
End Sub

 

[Nadine1988]

Hi -thank you. I know how I can code it but I don't know how (and where) to insert it in the above listed code so that both codes work ...

 

[Herakles]

Insert it after the variable declarations so that code execution stops after the rows are either hidden or made visible if cell

D43 changes but executes your existing code if cell D43 has not changed.



.

 

[Nadine1988]

That's not working... i don't know how to do it - your start is different already in the code...

I've added it like this (you can see it in bold)


'Mehrfachselektion mit Löschfunktion

Option Explicit
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 = vbCrLf
Dim DelimiterCount As Integer
Dim TargetType As Integer
Dim i As Integer
Dim arr() As String


If Not Intersect(Target, Range("D43")) Is Nothing Then

Cells.EntireRow.Hidden = True

If Range("D43").Value = "No" Then
Rows("45:52").EntireRow.Hidden = True
ElseIf Range("D43").Value = "Yes" Then
Rows("45:52").EntireRow.Hidden = False
End If
End If

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 <> "$C$41" And Destination.Address <> "$D$41" And Destination.Address <> "$C$51" And Destination.Address <> "$D$51" 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

 

[Herakles]

Just replace your bold code with the code below.

If Target = Range("$D$43") Then
        ActiveSheet.Rows("45:55").EntireRow.Hidden = Target.Value = "No"
        Exit Sub
    End If

Cells.EntireRow.Hidden = True
will hide all rows. Did you want that?

Do you want to hide rows 45 to 55 or 45 to 52?

 

[Nadine1988]

no... that's wrong, thanks! but it doesn't work anyways so...

45 to 52, file has been updated since my first post.

 

[Herakles]

You have replaced the Standard 'Target' in this line with destination.
Private Sub Worksheet_Change(ByVal 'Destination' As Range)

It is always best to stick with what Excel give you as a default.

Put 'Option Explicit' as the first line in all code modules as this will identify when variables have not been declared.

 

[Nadine1988]

okay that's not working either... any other suggestions from anyone? or can someone add the code to my existing code so that it's working? i'm running out of time with this...

 

[Herakles]

Can you post your code with the changes that you have made but by using the VBA Quick-wrap selection as VBA code icon on the Mr Excel editor ribbon.