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

 

[Nadine1988]

it's a dropdown so yes, it only has these two options but nothings happens when I choose one of the two options.

 

[Nadine1988]

"The position is correct if you want the rows to be hidden before your original code executes." - hmm... okay, they should actually both be executed at the same time.. it's a form which needs to be filled in so people probably won't do every row at a time... is this even possible?

 

[Herakles]

Put a MsgBox in to check the value of D43.

Check for a space either before or after the 'Yes' or 'No' or maybe even before and after.

        Cells.EntireRow.Hidden = False
        
         MsgBox ">" & Range("D43").Value & "<"

 

[Herakles]

"The position is correct if you want the rows to be hidden before your original code executes." - hmm... okay, they should actually both be executed at the same time.. it's a form which needs to be filled in so people probably won't do every row at a time... is this even possible?

Sure the checks that you are making are only valid for some cells.

If that is the case then only run the code when those particular cells have been changed.

It appears that you are only checking cells where the validation type is list.

Have you no control on what goes in the list?

 

[Nadine1988]

Sure the checks that you are making are only valid for some cells.

If that is the case then only run the code when those particular cells have been changed.

It appears that you are only checking cells where the validation type is list.

Have you no control on what goes in the list?

Yes, it's all more or less with drop down but I can't tell in wich order the fields will be filled out.

 

[Nadine1988]

Put a MsgBox in to check the value of D43.

Check for a space either before or after the 'Yes' or 'No' or maybe even before and after.

        Cells.EntireRow.Hidden = False
       
         MsgBox ">" & Range("D43").Value & "<"

tried that too... still not working ... i will try again, but thanks for your help!

 

[Herakles]

tried that too... still not working ... i will try again, but thanks for your help!

Did you put this line in:

MsgBox ">" & Range("D43").Value & "<"

Did the message display?

 

[Herakles]

Yes, it's all more or less with drop down but I can't tell in wich order the fields will be filled out.

Can you explain what you are trying to do when a selection from a validation list is made?

 

[Nadine1988]

hold on - it's working don't know how but it's working!

can you now tell me how I can an other one with the same code but different cells - i tried to simply copy it but it's only working for D43 but not for D55

'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

        Cells.EntireRow.Hidden = False
        
        If Range("D43").Value = "No" Then
            Rows("44:52").EntireRow.Hidden = True
        ElseIf Range("D43").Value = "Yes" Then
            Rows("44:52").EntireRow.Hidden = False
        
        End If
        
        
        If Range("D55").Value = "No" Then
            Rows("57:65").EntireRow.Hidden = True
        ElseIf Range("D55").Value = "Yes" Then
            Rows("57:65").EntireRow.Hidden = False
        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
            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

'Command Button

Private Sub CommandButton1_Click()
Dim xOutlookObj As Object
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    On Error Resume Next
    
    If IsEmpty(Range("A7")) Then
    MsgBox "Enter date"
    GoTo ends
    
    Else
    If IsEmpty(Range("D7")) Then
    MsgBox "Enter Vizrt sales peson"
    GoTo ends
        
    Else
    If IsEmpty(Range("C9")) Then
    MsgBox "Enter the start date of your rental"
    GoTo ends
  
    Else
    If IsEmpty(Range("C11")) Then
    MsgBox "Enter the end date of your rental"
    GoTo ends
    
End If
End If
End If
End If
    
    
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Please add any special requirements here. For FOC rentals - please attach Vanessa's approval to your email." & vbNewLine & vbNewLine & _
              "" & vbNewLine & _
              ""
                  On Error Resume Next
    With xOutMail
        .To = "non@vizrt.com"
        .CC = ""
        .BCC = ""
        .Subject = "Enter the Email Subject Here"
        .Body = xMailBody
        .Attachments.Add ActiveWorkbook.FullName
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
    
ends:
      
End Sub

 

[Herakles]

Are you trying to hide other rows based upon the value in particular cells a you did with D43?

If not then what are you trying to do?

What was the original code doing?