Restrict only two selections in a multi selection drop down in Excel - excel

Question

I have a dropdown in my excel sheet and I wanted to add multiple items from that dropdown into the cell. I was able to do that and now it functions as shown in the picture below:
I also wanted the users to only be allowed to choose two items from the entire list of items from the dropdown. The users can choose any two but also only two. I was not able to do that. Can someone help me? here is the code I used.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Address = "$C$8" Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = "" Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
If InStr(1, Oldvalue, Newvalue) = 0 Then
Target.Value = Oldvalue & vbNewLine & Newvalue
Else:
Target.Value = Oldvalue
End If
End If
End If
End If
If Target.Address = ("$C$8") Then
If InStr(1, Target.Value, "5", vbTextCompare) > 0 Then
Rows("9").EntireRow.Hidden = False
Else
Rows("9").EntireRow.Hidden = True
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

Answer 1

I had a hard time to understand your question and also the code. It is a very uncommon behavior that you have a data validation dropdown that allows to add something into that cell. This results in a very strange user experience
When I select an entry from the list, there is no way to remove it again except clearing the cell.
When I select something and then press Ctrl+Z (undo), Excel cannot undo my change.
When I select more than the limit (2) number of entries, the change is not accepted, without further notice.
When I enter something manually in that cell and the limit of 2 entries is already reached, my changes will not be accepted.
For me as a user, that strange behaviour would drive me mad. As a clever user, I will find out sooner or later that I can Paste something into that cell. That will delete your data validation - If you want to go down that road, you must add logic into the trigger that prevents this.
That said, I cleaned up your code and added a check for a maximum number of entries - the change itself is rather easy, before adding the entry, it is checked how many NewLines are already in the value.
Private Sub Worksheet_Change(ByVal Target As Range)
Const MaxEntries = 2
Dim Oldvalue As String
Dim Newvalue As String
If Target.Address <> "$C$8" Then GoTo Exitsub
On Error GoTo Exitsub
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then GoTo Exitsub
If Target.Value = "" Then GoTo Exitsub
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
ElseIf InStr(Oldvalue, Newvalue) = 0 And countCharsInStr(Oldvalue, vbNewLine) + 1 < MaxEntries Then
Target.Value = Oldvalue & vbNewLine & Newvalue
Else
Target.Value = Oldvalue
End If
Rows("9").EntireRow.Hidden = InStr(Target.Value, "5") > 0
Exitsub:
Application.EnableEvents = True
End Sub
Public Function countCharsInStr(s As String, c As String) As Long
countCharsInStr = (Len(s) - Len(Replace(s, c, ""))) / Len(c)
End Function

Answer 2

The code structure doesn't make much sense to me, so I rearranged it.
My solution is a separate function anyway, so it should work either way.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Address = "$C$8" Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
ElseIf Target.Value = "" Then
GoTo Exitsub
Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
If InStr(1, Oldvalue, Newvalue) = 0 And Not CountLines(Target) > 1 Then
Target.Value = Oldvalue & vbNewLine & Newvalue
Else
Target.Value = Oldvalue
End If
End If
End If
If InStr(1, Target.Value, "5", vbTextCompare) > 0 Then
Rows("9").EntireRow.Hidden = False
Else
Rows("9").EntireRow.Hidden = True
End If
End If
Exitsub:
Application.EnableEvents = True
End Sub
Public Function CountLines(Target As Range) As Double
Dim H1 As Double, H2 As Double
With Target
.WrapText = False
H1 = .Height
.WrapText = True
H2 = .Height
End With
CountLines = H2 / H1
End Function
Since the added values are separated by a new line, counting how many values there are can be a bit tricky. One way would be to measure the height of the cell, which is what the function does.
We call this function to check the number of lines as we are adding new values. I merged it with the If checking for duplicates.