Search code examples
excelvbamulti-selectcheckmarktensorflow-data-validation

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


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

Solution

  • 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