Добавление раскрывающегося списка множественного выбора в столбце для всех строк в Excel

Question

У меня есть лист, на котором я должен разрешить выделение более одного значения в ячейке. Я хотел бы выпадающий список с флажками.

Это VBA, который делает раскрывающийся список.

Как добавить его в каждую ячейку в столбце «Дорожная карта»? Как получить значения выбора?

Private Sub Worksheet_Change(ByVal Target As Range)

'
'   Calculate Percentages for Each Quarter
'

    Dim this_sheet, select_period
    this_sheet = ActiveSheet.Name

    If Not Intersect(Target, Range("J2")) Is Nothing Then
        ActiveSheet.Cells(2, 12).Value = 0
        select_period = ActiveSheet.Cells(2, 10).Value
        'MsgBox ("Creeps! " & this_sheet & " " & select_period)
        ActiveSheet.Cells(2, 11).Value = " " & select_period & ": "
        ActiveSheet.Cells(2, 11).HorizontalAlignment = xlCenter

        Select Case select_period

            Case "Overall"
                ActiveSheet.Cells(2, 12).Formula = "=COUNTIFS($I10:$I3000,""Done"",$L10:$L3000,""2019"")/COUNTIF($L10:$L3000,""2019"")"

            Case "2019"
                ActiveSheet.Cells(2, 12).Formula = "=COUNTIF($L10:$L3000,""2019"")"
                ActiveSheet.Cells(2, 13).Formula = "=COUNTIFS($I10:$I3000,""Done"",$L10:$L3000,""2019"")/COUNTIF($L10:$L3000,""2019"")"

            Case "2020"
                ActiveSheet.Cells(2, 12).Formula = "=COUNTIF($L10:$L3000,""2020 - Q1"")"
                ActiveSheet.Cells(2, 13).Formula = "=COUNTIFS($I10:$I3000,""Done"",$L10:$L3000,""2020 - Q1"")/COUNTIF($L10:$L3000,""2020 - Q1"")"

            Case "2020 - Q1"
                ActiveSheet.Cells(2, 12).Formula = "=COUNTIF($L10:$L3000,""2020 - Q1"")"
                ActiveSheet.Cells(2, 13).Formula = "=COUNTIFS($I10:$I3000,""Done"",$L10:$L3000,""2020 - Q1"")/COUNTIF($L10:$L3000,""2020 - Q1"")"

        End Select
    End If

'
' Create Multiple Selection Listbox
'

    Dim LBColors As MSForms.ListBox
    Dim LBobj As OLEObject
    Dim i As Long

    Set LBobj = Me.OLEObjects("LB_Colors")
    Set LBColors = LBobj.Object

    If Not Intersect(Target, Range("H2")) Is Nothing Then
        Set fillRng = Target
        With LBobj
            .Left = fillRng.Left
            .Top = fillRng.Top
            .Width = fillRng.Width
            .Visible = True
        End With
    Else
        LBobj.Visible = False
        If Not fillRng Is Nothing Then
            fillRng.ClearContents
            With LBColors
                If .ListCount <> 0 Then
                    For i = 0 To .ListCount - 1
                        If fillRng.Value = "" Then
                            If .Selected(i) Then fillRng.Value = .List(i)
                        Else
                            If .Selected(i) Then fillRng.Value = _
                                fillRng.Value & "," & .List(i)
                        End If
                    Next
                End If
                'For i = 0 To .ListCount - 1
                '    .Selected(i) = False
                'Next
            End With
            Set fillRng = Nothing
        End If
    End If


End Sub

Файл Excel здесь