Set individual cells as range for dropdown list

[Fredrik1987]

Hi again!

I'm having some difficulties setting a range to use in a dropdown list. There's no problem as long as the range is continuously ("A1:A10" etc.). However, in some instances the list will have more than 100 items in it. So I've created a script that finds the cells containing the headings (so far so good).

The problem occurs when I try to set these individual cells as a range (e.g the cells are A1, A5, A20 etc).
So far I've tried using different combinations of Intersect, cells() and range() without any luck. Error message 1004.

I'm calling the sub from a Worksheet_Change event.

Sub worksheet_change(ByVal target As Range)
Application.EnableEvents = False
'Application.ScreenUpdating = False

Cells.ClearComments
iActiveRow = target.Row
iActiveColumn = target.Column

call Paragrafer

Application.EnableEvents = True
'Application.ScreenUpdating = True

end sub


Private Sub Paragrafer_Sub()
dim i as integer
dim iActiveRow as integer '= Active Row Worksheet_Change sub
dim iLastRow_ColumnA as integer

Dim iFirstcell As Integer
Dim iLastcell As Integer
Dim icounter As Integer
Dim counter2 As Integer

Dim rDropdown As Range
Dim vArray_Overskrift(1 To 7) As Integer

iLastRow_ColumnA = 10

' Setter inn overskrifter for § 3.3
If Cells(iActiveRow, 1).Value = "3.3" Then
    icounter = 0
    For i = iFirstcell - 1 To iLastcell
        If Not sheets(3).Cells(i, 1).Value = Cells(iActiveRow, 1) Then
            icounter = icounter + 1
            vArray_Overskrift(icounter) = i
        End If
    Next i

Set rng1 = sheets(3).Cells(vArray_Overskrift(1), 1)
Set rng2 = sheets(3).Cells(vArray_Overskrift(2), 1)
Set rng3 = sheets(3).Cells(vArray_Overskrift(3), 1)
Set rng4 = sheets(3).Cells(vArray_Overskrift(4), 1)
Set rng5 = sheets(3).Cells(vArray_Overskrift(5), 1)
Set rng6 = sheets(3).Cells(vArray_Overskrift(6), 1)

' This is the range I'm trying to implement, i.e rDropdown = rng7
Set rng7 = Intersect(rng1, rng2, rng3, rng4, rng5, rng6)

'Setting the range this way don't give any error message, but I'm not sure this is the correct way do set the range?
ActiveWorkbook.Names.Add Name:="rDropdown", _
RefersTo:=sheets(3).Range("A" & vArray_Overskrift(1) & _
",A" & vArray_Overskrift(2) & _
",A" & vArray_Overskrift(3) & _
",A" & vArray_Overskrift(4) & _
",A" & vArray_Overskrift(5) & _
",A" & vArray_Overskrift(6))
End If

With Cells(iActiveRow, 2).Validation
    .Delete
    .Add xlValidateList, _
    xlValidAlertStop, _
    xlBetween, Formula1:="=rDropdown" ' Error 1004
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = False
End With

End Sub

 

[Fredrik1987]

Still haven't found a solution, if anyone reads this later it looks like the simplest solution is to implement add a few lines that finds the headings and copy them to a new range. THEN use this new range as a source for the dropdown list