Data Validation doesn't Work

jacof

New Member
Joined
Jan 16, 2011
Messages
15
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:

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.
 

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)
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.
 
Upvote 0
AlphaFrog:

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

Code:
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
 
Upvote 0
If it's fixed, then I don't know what else to tell you.

One very minor suggestion;

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

With just this (I think)...
Code:
Set AllCells = Range(TheCell.Offset(-1), Cells(RowHeads + 1, TheCell.Column))
 
Upvote 0

Forum statistics

Threads
1,213,538
Messages
6,114,220
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top