By excel vba adding checkmarks to each options selected in a multi-select datavalidation dropdown list

61 Views Asked by At

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.

enter image description here

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
1

There are 1 best solutions below

1
taller On BEST ANSWER

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