(Solved) – VBA – dropdrow list disappears after save and reopen


I try to create some dropdown lists based on the contents of some ranges on another sheet and add conditional formatting to the cells involved.

The code works BUT after saving the file and reopening the file the dropdrown list disappear!
Why and how can avoid it (I want to keep the definition on another worksheet)?

I can provide an excample file (but how?)

I’m not running any code on worksheet_open() or so.

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)
        Dim arrValues As Variant
        Dim inList As Boolean
        Dim kleur As Long
        Dim waarde 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
                    If (inList = False) Then
                        With rngEvenement.Validation
                        ' Hernieuw de dropdown list
                            .Add xlValidateList, xlValidAlertStop, Formula1:="=Instellingen!$D$5:$D$10"
                            .IgnoreBlank = True
                            .InCellDropdown = True
                            .ShowInput = True
                        End With
                        inList = True
                    End If
                    waarde = .Cells(i, 2)
                    With .Cells(i, 1)
                        kleur = .Interior.Color
                        With rngEvenement.FormatConditions.Add(xlCellValue, xlEqual, waarde)
                            .StopIfTrue = True
                            .Interior.Color = kleur
                        End With
                    End With
                End If
            Next i
        End With
    Next element
End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *