Error 1004 for string name in refersto

[bradyboyy88]

My code is drawing a 1004 application defined error and I have found it to be because of the refersto. What is going wrong with this?

Option Explicit


Sub NameRanges()


Dim ws As Worksheet
Dim cl As Range
Dim wsIndex As Integer
Dim InputString As String
Dim CalcString As String


InputString = "= "
CalcString = "= "


    For Each ws In ThisWorkbook.Worksheets
        For Each cl In ws.UsedRange
            If cl.Interior.Color = vbYellow Then
                InputString = InputString & "'" & ws.Name & "'!" & cl.Address(ReferenceStyle:=xlR1C1) & ", "
            ElseIf cl.HasFormula() = True Then
                CalcString = CalcString & "'" & ws.Name & "'!" & cl.Address(ReferenceStyle:=xlR1C1) & ", "
            End If
        Next cl
        
        If ws.Index <= 8 Then
            wsIndex = ws.Index
        Else
            wsIndex = ws.Index - 8 & "2"
        End If


        Debug.Print Left(InputString, Len(InputString) - 2)
        ThisWorkbook.Names.Add _
                Name:="InputsWS" & wsIndex, _
                RefersToR1C1:=Left(InputString, Len(InputString) - 2)


        ThisWorkbook.Names.Add _
                Name:="Calc" & wsIndex, _
                RefersToR1C1:=Left(CalcString, Len(CalcString) - 2)
    Next ws
End Sub

 

[DanteAmor]

Use the @Fluff example

 

[bradyboyy88]

I will give this a try!

 

[bradyboyy88]

The limit is about 2100
Try

    For Each ws In ThisWorkbook.Worksheets
        For Each cl In ws.UsedRange
            If cl.Interior.Color = vbYellow Then
               If rng Is Nothing Then Set rng = cl Else Set rng = Union(rng, cl)
            ElseIf cl.HasFormula() = True Then
                CalcString = CalcString & "'" & ws.Name & "'!" & cl.Address(ReferenceStyle:=xlR1C1) & ", "
            End If
        Next cl
        
        If ws.Index <= 8 Then
            wsIndex = ws.Index
        Else
            wsIndex = ws.Index - 8 & "2"
        End If

        Debug.Print "'" & ws.Name & "'!" & rng.Address(1, 1, xlR1C1)

        ThisWorkbook.Names.Add _
                Name:="InputsWS" & wsIndex, _
                RefersToR1C1:="'" & ws.Name & "'!" & rng.Address(1, 1, xlR1C1)


        ThisWorkbook.Names.Add _
                Name:="Calc" & wsIndex, _
                RefersToR1C1:=Left(CalcString, Len(CalcString) - 2)
    Next ws

& similar for the Calc range

I am still get 1004 error with this update based off your code:

Option Explicit


Sub NameRanges()
    Dim ws As Worksheet
    Dim cl As Range
    Dim wsIndex As Integer
    Dim RngInput As Object
    Dim RngCalc As Object




    For Each ws In ThisWorkbook.Worksheets


        For Each cl In ws.UsedRange
            If cl.Interior.Color = vbYellow Then
                If RngInput Is Nothing Then Set RngInput = cl Else Set RngInput = Union(RngInput, cl)
            ElseIf cl.HasFormula() = True Then
                If RngCalc Is Nothing Then Set RngCalc = cl Else Set RngCalc = Union(RngCalc, cl)
            End If
        Next cl
        
        If ws.Index <= 8 Then
            wsIndex = ws.Index
        Else
            wsIndex = ws.Index - 8 & "2"
        End If
    
        MsgBox "test1"
        ThisWorkbook.Names.Add _
                    Name:="InputsWS" & wsIndex, _
                    RefersToR1C1:="'" & ws.Name & "'!" & RngInput.Address(1, 1, xlR1C1)
        MsgBox "test2"
        ThisWorkbook.Names.Add _
                    Name:="Calc" & wsIndex, _
                    RefersToR1C1:="'" & ws.Name & "'!" & RngCalc.Address(1, 1, xlR1C1)
        
        Set RngInput = Nothing
        Set RngCalc = Nothing
    Next ws
End Sub

 

[bradyboyy88]

Your addition of the equal sign with the range application fixed the error. Unfortunately it didnt name all the correct cells so I need to figure that out lol!

 

[bradyboyy88]

Actually it looks to be right. I would think the name property would change the top left name when you click on the cell. Doesnt seem to be doing that but it shows up in the name manager.

 

[Fluff]

Glad it's sorted & thanks for the feedback