Named Range Duplication/ Formula Altering

Question

I am currently working within a tab with named ranges. They are all associated with class 1. I would like to duplicate these cells twice, creating identical columns for classes 2 and 3. The named ranges should remain the same aside from a _2/_3 attached for the next two classes. I also need the formulas to be changed within each column, but containing the correct suffix(_2/_3).

This is a simplified version to better explain what I am trying to do:

**Class 1** 

  Lives         
  Age       
  Adjust        
  Claim     
  Risk      

**Class1    Class2      Class3**

  Lives     Lives_2     Lives_3

  Age       Age_2       Age_3

  Adjust    Adjust_2    Adjust_3

  Claim     Claim_2     Claim_3

  Risk      Risk_2      Risk_3

These are representative of the names of the cells; they all also contain formulas linking within each class. The class 1 area that is already completed has 9 columns and 120 rows. I would like class two to populate column 10 to 18 and class 3 the next 9. Here is the code I was working with to try to just change the names but I was unsuccessful:

Sub ChangeNames()
    Dim OldName As String
    Dim NewName2 As String
    Dim NewName3 As String
    Dim rng As Range



    For r = 1 To 127
        For c = 1 To 10
            If IsNamedRange(Cells(r, 1 + c)) Then
                    Set rng = Sheets("Medical").Cells(r, 1 + c)

                    OldName = rng.Name
                    NewName2 = OldName & "_2"
                    NewName3 = OldName & "_3"

                    Sheets("Medical").Cells(r, 11 + c).Name = NewName2
                    Sheets("Medical").Cells(r, 21 + c).Name = NewName3

            End If

        Next c
    Next r


End Sub

Function IsNamedRange(MyRange) As Boolean
    Dim vntName As Variant
    On Error Resume Next
        IsNamedRange = MyRange.Name <> ""
    Exit Function
End Function

Is this possible with VBA? Any help would be much appreciated!

Sub names() Dim this As String Dim OldName As String Dim NewName2 As String Dim NewName3 As String Dim x As Integer Dim y As Integer

For Each this In Workbook.names
    If Range(this).Worksheet = "Medical" Then
        NewName2 = Range(this).Name & "_2"
        NewName3 = Range(this).Name & "_3"
        x = Range(this).Column
        y = Range(this).Row
        Sheets("Medical").Cells(x, 10 + y).Name = NewName2
        Sheets("Medical").Cells(x, 20 + y).Name = NewName3
    End If

Next this

End Sub

Is this possible with VBA - Yes. but I was unsuccessful - If you elaborate on what is not working, we can help you more. — Scott Holtzman
When I run the above code; the old name variable has a value of "=Medical!$b$3" rather than Med_Prod which is the name of the cell -- how do I have it return the name range rather than cell location. Let me know if I need to clarify further — Brian
this is going to be complex ... you are going to have to loop through the names collection in the workbook - make sure they are on the sheet you want, then define the column they are in, then use offset and a counter to set them to *n* columns over with the name_*x* — Scott Holtzman

Scott Holtzman Scott Holtzman · Accepted Answer · 2016-07-19T17:34:05

Try this code out, you may need to make small adjustments to the offset or tweaks to fit your exact data set, but I defined it as precisely as I could.

Sub ChangeNames()

    Dim rName As Name
    For Each rName In ThisWorkbook.Names

        If rName.RefersToRange.Parent.Name = "Medical" Then

            Select Case rName.RefersToRange.Column

                Case 2 To 10

                    For i = 1 To 2

                        Dim sName As String
                        sName = "=" & rName.RefersToRange.Offset(, i * 10).Parent.Name
                        sName = sName & "!" & rName.RefersToRange.Offset(, i * 10).Address
                        ThisWorkbook.Names.Add rName.Name.Name & "_" & i + 1, RefersTo:=sName

                    Next

            End Select

        End If

    Next

End Sub

Named Range Duplication/ Formula Altering

1 Answers