validation list help

[bebe1279]

I'm trying to get this in cell validation list to work but I'm not having any luck so far.
this is what the code is meant to do...
open the reference wkbk & go the reference sheet
starting at col B row 2 add value of cell to ctcType collection & continue to down column B adding value of cells until cell is empty
close reference wkbk
go to contact profile sheet of the active wkbk & to range I9:J9
add validation list from ctcType collection gathered from reference wkbk
when I run code, I get "Application defined or object defined error" on this line

.Add Type:=xlValidateList, Formula1:=ctcType

Here is the whole code

Sub ProfileContactType()

'Get contact type data from reference sheet and store in ctcType collection
Dim ctcType As Collection
Dim refWb As Workbook
Dim row As Integer
Dim col As Integer

'create new collection
Set ctcType = New Collection

'open reference workbook and set var
Set refWb = Workbooks.Open("C:\AppName\Program\Reference WB.xlsm")

'assign values. column 2 or B, row 2
row = 2
col = 2

'Within the reference sheet of the reference WB
With refWb.Sheets("Reference Sheet")
    'Add cell value to collection until cells of column B is blank
    Do Until Cells(row, col).Value = ""
        ctcType.Add (Cells(row, col).Value)
        row = row + 1
    Loop
End With
    
'close reference WB
    refWb.Close
    
'Go to Contact profile sheet and contact type range, _
    create combo box and populate with collection items
With ThisWorkbook.Sheets("Contact Profile").Range("I9:J9").Validation
     .Delete
     .Add Type:=xlValidateList, Formula1:=ctcType
End With
End Sub

Thanks in advance for any help

 

[dmt32]

Hi,
not tested but see if this update to your code does what you want

Sub ProfileContactType()
    Dim refWb As Workbook
    Dim arr As Variant
    
'open reference workbook and set var
    Application.ScreenUpdating = False
    Set refWb = Workbooks.Open("C:\AppName\Program\Reference WB.xlsm", ReadOnly:=True)
    
'Within the reference sheet of the reference WB
    With refWb.Sheets("Reference Sheet")
        arr = Application.Transpose(.Range(.Range("B2"), .Range("B" & .Rows.Count).End(xlUp)).Value)
    End With
        
'Go to Contact profile sheet and contact type range, _
        create combo box and populate with range
    With ThisWorkbook.Sheets("Contact Profile").Range("I9:J9").Validation
         .Delete
         .Add Type:=xlValidateList, Formula1:=Join(arr, ",")
    End With
    
'close reference WB
     refWb.Close False
     
     Application.ScreenUpdating = True
        
End Sub

Dave

 

[bebe1279]

That worked great, thank you.