Creating Named Ranges Using VBA - Run time error 1004

[Prevost]

Hi There. I am trying to create named ranges. All the range names are in the first row and below them is their respective range entries (the cell immediately below the name cell is intentionally left blank). I check the first row cells until I get to the end (where an empty cell is) to get the number of ranges. Then I search down the column, starting at the first column, until I reach an empty cell to determine the range length. There is an error when I attempt to assign the range name to the Cell containing the text. The code won't work when
[Name:= Cells(1,y)].......but I don't get an error when the code is [Name:= "String Text"].......but obviously I don't want every range to be named the same.
Any help is greatly appreciated!

Sub CreateRanges()
    Dim i As Integer, j As Integer, y As Integer, x As Integer
    Dim NewRange As Range
        i = 3: j = 1
            Do While Cells(1, j) <> vbNullString
                j = j + 1
            Loop
            For y = 1 To j
                Do While Cells(i, y) <> vbNullString
                    i = i + 1
                Loop
                Set NewRange = ActiveSheet.Range(Cells(3, y), Cells(i - 1, y))
                ActiveWorkbook.Names.Add Name:=Cells(1, y), RefersTo:=NewRange      'this line is highlighted when I click Debug
                y = y + 1
            Next
End Sub

 

[JLGWhiz]

try this

ActiveWorkbook.Names.Add Name:=Cells(1, y).Value, RefersTo:=NewRange.Address

 

[Prevost]

I still get the same error. I can change Cells(1,y) to Range("A1") and it works, but again I get only one new range created instead of all of the desired ranges in the worksheet.

 

[Prevost]

In case anyone views this thread here is the working code. The worksheet has ranges in each column and the first row is the range name and the second row is a blank space. All the rest of the entries follow underneath the empty cell. It then assigns the range name in the first row to the values underneath...my variables were incorrectly placed. Thanks.

Sub CreateRanges()
    Dim i As Integer, j As Integer, y As Integer, x As Integer
    Dim NewRange As Range
    Dim RangeName As String
        j = 1
            Do While Cells(1, j) <> vbNullString
                j = j + 1
            Loop
            j = j - 1
            For y = 1 To j
                i = 3
                    Do While Cells(i, y) <> vbNullString
                        i = i + 1
                    Loop
                i = i - 1
                Set NewRange = ActiveSheet.Range(Cells(2, y), Cells(i, y))
                RangeName = Cells(1, y)
                ActiveWorkbook.Names.Add Name:=Cells(1, y), RefersTo:=NewRange
            Next
End Sub

 

[jim may]

RangeName = Cells(1, y) < < variable assigned, But not used.

 

[mikerickson]

Try

RefersTo: ActiveWorkbook.Names.Add Name:=Cells(1, y), RefersTo:= "=" & NewRange.Address(,,,True)