By the following vba excel code which I found on the internet, I can select more than one option within a cell from the dv dropdown list at the same time. What I am trying to do is to add a checkmark to the beginning of each option if more than one option is selected (if one option is selected, there should not.) I modified the original code for to do this, however, I was only able to achieve the result in the picture . By the modification i made, I can add checkmarks to all selected options in the cell except the first option.
How can a checkmark be added automatically to the beginning of each options selected within a cell when more than one option is selected? Thank you very much in advance for your help.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Not Intersect(Target, Range("C3:C28,F3:F28,G3:G28,H3:H28,J3:J28,L3:L28,M3:M28,N3:N28")) Is Nothing 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 & ChrW(&H2713) & Newvalue
Else:
Target.Value = Oldvalue
End If
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub
Updated code is marked with **.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Not Intersect(Target, Range("C3:C28,F3:F28,G3:G28,H3:H28,J3:J28,L3:L28,M3:M28,N3:N28")) Is Nothing 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
If AscW(Left(Oldvalue, 1)) <> &H2713 Then ' **
Oldvalue = ChrW(&H2713) & Oldvalue
End If ' **
Target.Value = Oldvalue & vbNewLine & ChrW(&H2713) & Newvalue
Else:
Target.Value = Oldvalue
End If
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub