CODEWITHSUNDEEP
vbaexcel
user3683463
user3683463

Reputation: 71

Creating a Validation List in VBA

I can't work out why this isn't working. I have a subroutine which builds a validation list from data on another Excel worksheet. I have similar subroutines that work okay but not this one.

If I change 

    ReDim CatsValidationList(catsArray.Count)

to

    ReDim CatsValidationList(100)

Or any number, then it works fine. I know catsArray is populated and there is also a figure for catsArray.Count. So what am I missing when it comes to resizing the array? Hopefully someone can help. Full code for the sub is here...

Sub all_cats()

'Set some variables
Dim category_list As Range
Dim catRng() As Variant
Dim catsArray As New Collection

'Empty
Range("D15:D1000").Clear
Range("F15:F1000").Clear

'Set range of data
Set category_list = Worksheets("All Cats").Range("B1", Worksheets("All Cats").Range("B10000").End(xlUp))
catRng = category_list

'Populate array with data
On Error Resume Next
For Each ct In catRng
catsArray.Add ct
Next

'Resize array
ReDim CatsValidationList(catsArray.Count)

'Populate array for validation list
For xx = 1 To UBound(CatsValidationList)
CatsValidationList(xx) = Worksheets("All Cats").Range("B" & xx).Value
Next xx

'Build validation list
With Range("D15").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
    Operator:=xlEqual, Formula1:=Join(CatsValidationList, ",")
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = False
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

End Sub

With Public CatsValidationList() As Variant at the top

I've tried declaring it within the sub, I've tried assigning the number to a variable. But it's not happy.

Thanks in advance

It is part of a larger program I've written that compiles validation lists of matching keywords in a small keyword list from the main dataset. The sub for the matching keywords works fine and I'm trying to write the sub for all_cats the same way. It features a resized array... ReDim ValidationList1(stylecats_exact.Count) and a bit that looks for matching words and adds them to the array

If child_cat_exact > 0 Then
stylecats_exact.Add Trim(Worksheets("All Cats").Range(catlist_index & cat_item.Row).Value) & " [" & Worksheets("All Cats").Range(catid_index & cat_item.Row).Value & "]"
Else

which isn't required in the all_cats sub. But there's something missing somewhere because I can't populate the CatsValidationList with

ReDim CatsValidationList(catsArray.Count)

unless I put in a specific number

ReDim CatsValidationList(190)

which is no good because the full list can often change.

I'm puzzled...:(

Upvotes: 2

Views: 821

Answers (1)

user3683463
user3683463

Reputation: 71

As pointed out in the comments, the issue was with the validation list length rather than anything else. So I took the advice of using a range rather than build up an array to populate the list with. It now works fine. (Thanks Rory) For those who have come here looking for a similar solution to a similar issue, I amended the validation bit to include .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:="=" & category_list

With the variable category_list referring to the range from another worksheet called All Cats. category_list = "'All Cats'!B2:B" & cat_end_row

Full code for my sub is below for anyone else's reference and to put the above into context. I'm sure there are other ways of writing it that are cleaner and more efficient, but for now this works okay for me. Thanks StackOverflow

'Set some variables
Dim category_list As String
Dim catRng() As Variant
Dim catsArray As New Collection
Dim cat_end_row As Integer

'Empty
Range("D15:D1000").Clear
Range("F15:F1000").Clear

'Find end row
cat_end_row = Worksheets("All Cats").Range("B1000000").End(xlUp).Row

'Set range of data
category_list = "'All Cats'!B2:B" & cat_end_row

'Build validation list
With Range("D15").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
    Operator:=xlBetween, Formula1:="=" & category_list
    .IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = False
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

Upvotes: 1

Related Questions