Dropdrown список исчезает после сохранения и снова открывается

Question

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

Код работает НО после сохранения файла и повторного открытия файла в раскрывающемся списке исчезают! Почему и как этого можно избежать (я хочу сохранить определение на другом листе)?

Я могу предоставить файл примера (но как?)

Я не запускаю никакого кода на worksheet_open () или около того.

Sub InitiateCriteria()
' Add conditional formatting to Range(Evenementen_Overzicht) based on Criteria provided on sheet(Instellingen)

    Dim nameEvenementen: nameEvenementen = "Evenementen_Overzicht"          ' Naam range met de Evenementen
    Dim prefixNameCriteria: prefixNameCriteria = "Criteria_"                ' Prefix van elke range die een Criteria is
    Dim prefixNameEvenementen: prefixNameEvenementen = "Evenementen_"       ' Prefix van elke range in Evenementen_Overzicht die op basis van Criteria_ wordt verwerkt
    Dim nameCriteria As String
    Dim nameEvenement As String

    Dim arrNameRanges: arrNameRanges = Array("Evaluatie_Oordeel", "Bezoekers_Waardering")
    Dim element As Variant
    For Each element In arrNameRanges
        nameCriteria = prefixNameCriteria & element
        Dim rngCriteria As Range
        Set rngCriteria = Range(nameCriteria)
        nameEvenement = prefixNameEvenementen & element
        Dim rngEvenement As Range
        Set rngEvenement = Range(nameEvenement)
        rngEvenement.FormatConditions.Delete
        Dim inList As Boolean
        Dim kleur As Long
        Dim waarde As String
        Dim keuzes As String
        With rngCriteria
            Dim numRows: numRows = .Rows.Count
            Dim i As Integer
            inList = False
            For i = 1 To numRows
                If (UCase(.Cells(i, 3)) = "JA") Then
                ' Dit criteria staat in de dropdown list --> formuleer een conditie
                    With .Cells(i, 2)
                        kleur = .Interior.Color
                        With rngEvenement.FormatConditions.Add(xlCellValue, xlEqual, .Value2)
                            .StopIfTrue = True
                            .Interior.Color = kleur
                        End With
                    End With
                    If (inList = False) Then
                        With rngEvenement.Validation
                        ' Hernieuw de dropdown list
                            .Delete
                            keuzes = Range(rngCriteria.Cells(1, 2), rngCriteria.Cells(numRows, 2)).Address(True, True, xlA1, True)
                            keuzes = "=" & Right(keuzes, Len(keuzes) - InStr(keuzes, "]"))
                            .Add xlValidateList, xlValidAlertStop, xlBetween, keuzes
                            .IgnoreBlank = True
                            .InCellDropdown = True
                            .ShowInput = False
                        End With
                        inList = True
                    End If
                End If
            Next i
        End With
    Next element
End Sub