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

 

[bradyboyy88]

Could it possibly be the fact I am using the single quote inside the double quotes?

 

[Fluff]

How long is the string when you get the error?

 

[bradyboyy88]

How long is the string when you get the error?

3220

 

[DanteAmor]

Try this

Sub NameRanges()
    Dim ws As Worksheet
    Dim cl As Range
    Dim wsIndex As Integer
    Dim InputString As String
    Dim CalcString As String


    For Each ws In ThisWorkbook.Worksheets
        InputString = "= "
        CalcString = "= "
        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


        If InputString <> "= " Then
            Debug.Print Left(InputString, Len(InputString) - 2)
            ThisWorkbook.Names.Add _
                    Name:="InputsWS" & wsIndex, _
                    RefersToR1C1:=Left(InputString, Len(InputString) - 2)
        End If
        If CalcString <> "= " Then
            ThisWorkbook.Names.Add _
                    Name:="Calc" & wsIndex, _
                    RefersToR1C1:=Left(CalcString, Len(CalcString) - 2)
        End If
    Next ws
End Sub

 

[bradyboyy88]

Try this

Sub NameRanges()
    Dim ws As Worksheet
    Dim cl As Range
    Dim wsIndex As Integer
    Dim InputString As String
    Dim CalcString As String


    For Each ws In ThisWorkbook.Worksheets
        InputString = "= "
        CalcString = "= "
        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


        If InputString <> "= " Then
            Debug.Print Left(InputString, Len(InputString) - 2)
            ThisWorkbook.Names.Add _
                    Name:="InputsWS" & wsIndex, _
                    RefersToR1C1:=Left(InputString, Len(InputString) - 2)
        End If
        If CalcString <> "= " Then
            ThisWorkbook.Names.Add _
                    Name:="Calc" & wsIndex, _
                    RefersToR1C1:=Left(CalcString, Len(CalcString) - 2)
        End If
    Next ws
End Sub

That did not work. Its almost guarenteed that there is a InputString and CalcString for all sheets.

 

[DanteAmor]

There are too many cells in the InputString, excel does not support it.
Instead of cledas you could put ranges of cells

 

[Fluff]

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

 

[bradyboyy88]

There are too many cells in the InputString, excel does not support it.
Instead of cledas you could put ranges of cells

What do you mean by put ranges? Can you give an example of how you would do this?

 

[mikerickson]

The RefersTo argument should start with an equals sign.

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