Data Validation doesn't Work

[jacof]

Hi everybody

I have a code that makes a comma separated list from a collection, and then makes a cell validation with that list.

The purpose of this code is to detect the last cell in a column, and make the next one a drop down list with unique values from the column above. get it? Its to allow the selection of the 'next value' from an intelligent list, that remembers it if it didn't exist and you had to enter it.

The code makes use of a modification of a tip by J.G. Hussey, published in "Visual Basic Programmer's Journal".

Code:

    For Each Item In NoDupes
'        UserForm1.ListBox1.AddItem Item
         Ret = Ret & Item & ";"
    Next Item

    If Ret <> ";" Then
        Ret = Left(Ret, Len(Ret) - 1)
        
        '   Show the UserForm
        '    UserForm1.Show
        

        
        With TheCell.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:=CStr(Ret)
            .IgnoreBlank = False
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = False
            .ShowError = False
        End With
    End If

That is the troublesome part of the code.

The problem is that when I run this code from the Visual Basic Editor (pressing play) the functions function perfectly, and the validation returns a working list.

But when I start the code from Excel (Run Macro, or adding a Button that runs it), the validation doesn't work, and leaves a drop-down list with a unique raw value like "value1;value2;value3" and it doesn't validate it.

 

[AlphaFrog]

How is the NoDupes collection defined?
How is TheCell defined?

There may (or may not) be issues in the other part of the code that you didn't post.

 

[jacof]

AlphaFrog:

Well here's the whole code, but I think it's temporarily fixed by changing the ";" to a "," to separate lists.

Sub PlaceList(TheCell As Range, RowHeads As Integer)
'TheCell: celda a poner la lista, RowHeads: numero de fila con encabezados
    Dim AllCells As Range, Cell As Range, LastCell As Range
    Dim NoDupes As New Collection
    Dim i As Integer, j As Integer
    Dim Swap1, Swap2, Item
    Dim Ret As String
    Dim Col As String
    
'   The items are in A1:A105
    Col = "$" & Split(TheCell.Address, "$")(1) & "$" & (RowHeads + 1) & ":" & TheCell.Offset(-1, 0).Address
    Set AllCells = Range(Col)
'   The next statement ignores the error caused
'   by attempting to add a duplicate key to the collection.
'   The duplicate is not added - which is just what we want!
    On Error Resume Next
    For Each Cell In AllCells
        NoDupes.Add Cell.Value, CStr(Cell.Value)
'       Note: the 2nd argument (key) for the Add method must be a string
    Next Cell

'   Resume normal error handling
    On Error GoTo 0

'   Update the labels on UserForm1
'    With UserForm1
'        .Label1.Caption = "Total Items: " & AllCells.Count
'        .Label2.Caption = "Unique Items: " & NoDupes.Count
'    End With
    
'   Sort the collection (optional)
    For i = 1 To NoDupes.Count - 1
        For j = i + 1 To NoDupes.Count
            If NoDupes(i) > NoDupes(j) Then
                Swap1 = NoDupes(i)
                Swap2 = NoDupes(j)
                NoDupes.Add Swap1, before:=j
                NoDupes.Add Swap2, before:=i
                NoDupes.Remove i + 1
                NoDupes.Remove j + 1
            End If
        Next j
    Next i
    
'   Add the sorted, non-duplicated items to a ListBox
    For Each Item In NoDupes
'        UserForm1.ListBox1.AddItem Item
         Ret = Ret & Item & ","
    Next Item

    If Ret <> "," Then
        Ret = Left(Ret, Len(Ret) - 1)
        
        '   Show the UserForm
        '    UserForm1.Show
        

        
        With TheCell.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:=CStr(Ret)
            .IgnoreBlank = False
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = False
            .ShowError = False
        End With
    End If
End Sub

 

[AlphaFrog]

If it's fixed, then I don't know what else to tell you.

One very minor suggestion;

You could replace this....

    Col = "$" & Split(TheCell.Address, "$")(1) & "$" & (RowHeads + 1) & ":" & TheCell.Offset(-1, 0).Address
    Set AllCells = Range(Col)

With just this (I think)...

Set AllCells = Range(TheCell.Offset(-1), Cells(RowHeads + 1, TheCell.Column))

 

[jacof]

Thanks. I was looking for a cleaner way to do that.