Validatielijsten updaten

Status
Niet open voor verdere reacties.

johhnnyboy

Gebruiker
Lid geworden
18 nov 2007
Berichten
142
Onderstaande code probeer ik werkend te krijgen:

Code:
Function fn_ValidationFields_update(ColumnsArr As Variant, ListsArr As Variant, EndRow As Long)

    Dim RCell                   As range
    Dim SOptionsList            As String
    Dim Rcell2                  As range
    
    For i = LBound(ColumnsArr) To UBound(ColumnsArr)
    
        SOptionsList = ""
        
        For Each RCell In ListsArr(i)
        
            If Not IsEmpty(RCell) Then SOptionsList = SOptionsList & "," & RCell.Value
        
        Next
        
        For Each Rcell2 In ActiveSheet.range("" & ColumnsArr(i) & "1:" & ColumnsArr(i) & EndRow)
                
            If Rcell2.SpecialCells(xlCellTypeSameValidation).Cells.Count < 1 Then
                
                'do nothing
            
            Else
        
                With Rcell2.Validation
                    
                        .Delete
                        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                        xlBetween, Formula1:=Mid$(SOptionsList, 2)
                        .IgnoreBlank = True
                        .InCellDropdown = True
                        .InputTitle = ""
                        .ErrorTitle = ""
                        .InputMessage = ""
                        .ErrorMessage = ""
                        .ShowInput = True
                        .ShowError = True
                
                End With
                
            End If
            
        Next Rcell2
        
    Next

End Function

In de bovenstaande opzet ontstaat een fout op de regel:

Code:
For Each Rcell2 In ActiveSheet.range("" & ColumnsArr(i) & "1:" & ColumnsArr(i) & EndRow)

In de basisopzet die ik eerder had werkte de code prima (zonder de column array en List array), alleen zocht / zoek ik nog naar een oplossing om alleen bestaande validatielijsten te updaten op basis van de List array. Nu worden alle cellen in de range voorzien van een validatie lijst. Ook de tussenliggende cellen in mijn range welke nog geen validatielijst hadden. En dat is niet mijn bedoeling. Mijn doel is cellen die reeds een validatielijst hebben -> Updaten, cellen die geen validatielijst hebben -> Niks mee doen.

Kan iemand even meekijken?

Dit is hoe ik e.e.a. aanroep

Call fn_ValidationFields_update(Array("C", "D", "E", "F", "G"), Array(Blad2.range("MyList"), Blad2.range("MyList"), Blad2.range("MyList"), Blad2.range("MyList"), Blad2.range("MyList")), 100)
 
Laatst bewerkt:
Ik zou zeggen: doe er een voorbeeldje bij. En probeer je code wat compacter te posten, want wat is er mis met een versie zonder die lege regels? Is in ieder geval een stuk leesbaarder.
Code:
Function fn_ValidationFields_update(ColumnsArr As Variant, ListsArr As Variant, EndRow As Long)
Dim RCell                   As Range, Rcell2 As Range
Dim SOptionsList            As String
    
    For i = LBound(ColumnsArr) To UBound(ColumnsArr)
        SOptionsList = ""
        For Each RCell In ListsArr(i)
            If Not IsEmpty(RCell) Then SOptionsList = SOptionsList & "," & RCell.Value
        Next
        For Each Rcell2 In ActiveSheet.Range("" & ColumnsArr(i) & "1:" & ColumnsArr(i) & EndRow)
            If Rcell2.SpecialCells(xlCellTypeSameValidation).Cells.Count >= 1 Then
                With Rcell2.Validation
                        .Delete
                        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                        xlBetween, Formula1:=Mid$(SOptionsList, 2)
                        .IgnoreBlank = True
                        .InCellDropdown = True
                        .ShowInput = True
                        .ShowError = True
                End With
            End If
        Next Rcell2
    Next

End Function
 
Laatst bewerkt:
Johhnnyboy,

Ik kan je fout niet reproduceren en je hebt ook niet aangegeven welke fout er gegeven wordt.
Volgens mij gaat het fout in deze regel:
Code:
If Rcell2.SpecialCells(xlCellTypeSameValidation).Cells.Count >= 1 Then
Daar probeer je in een reeks, cellen te vinden met dezelfde validatie. Echter Rcell2 is geen reeks
maar een specifieke cel en dus krijg je een foutmelding "Fout 1004 in de uitvoering: Er zijn geen cellen gevonden".

Veel Succes.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan