Excel VBA

css navigation by Css3Menu.com

Change Named Areas

We had a huge spreadsheet that we needed to change the refernces of the named areas. Our queries placed data in Named Areas and not specific cells.
Sub ChangeLocOfNamed()
    Dim Coun As Double, A As Long
    Dim AreaArray As Variant, ItemArray
    Dim SheetArray, Changes As Long
'
' ChangeLocOfNamed Macro
' 4/5/2006  Change Named Areas
'
    Changes = 0
    Open ThisWorkbook.Path & "\ChangeLog.TXT" For Output As #1
    
    
    Workbooks("Tip_Summary.XLS").Activate
    SheetArray = Array("200604", "200605", "200606", "200607", "200608", "200609")
        'What sheets to fix
    AreaArray = Array("R9C6:R39C6", "R9C25:R39C25", "R9C15:R39C15", "R9C5:R39C5", "R9C24:R39C24", _
        "R9C14:R39C14", "R9C7:R39C7", "R9C26:R39C26", "R9C16:R39C16")
      'What to change TO
    ItemArray = Array("07110", "07120", "07130", "94110", "94120", _
        "94130", "94140", "94150", "94160") 'Named areas to find

    For Coun = LBound(SheetArray) To UBound(SheetArray) 'Increment sheets
        Sheets(SheetArray(Coun)).Select
            For A = LBound(AreaArray) To UBound(AreaArray)  'Increment areas tp Find
                Application.Goto reference:="temp_" & ItemArray(A)  'Find Area
        Print #1, "Old: " & Selection.Address   'Write to log
                ActiveWorkbook.Names.Add Name:="temp_" & ItemArray(A), RefersToR1C1:= _
                "=" & Sheets(SheetArray(Coun)).Name & "!R9C2:R39C2," & Sheets(SheetArray(Coun)).Name _
                & "!" & AreaArray(A)   'Change reference area on sheet
                Changes = Changes + 1
                Print #1, "New: " & Sheets(SheetArray(Coun)).Name & "!" & AreaArray(A)
            Next A
    Next Coun
    'Fix template sheet that will be used in future months to setup sheets
    Sheets("TEMPLATE").Visible = True
    Sheets("TEMPLATE").Select
    For A = LBound(AreaArray) To UBound(AreaArray)
        Application.Goto reference:="temp_" & ItemArray(A)
        Print #1, "Old: " & Selection.Address
        ActiveWorkbook.Names.Add Name:="temp_" & ItemArray(A), RefersToR1C1:= _
            "=" & Sheets("TEMPLATE").Name & "!R9C2:R39C2," & Sheets("TEMPLATE").Name _
            & "!" & AreaArray(A)
            Changes = Changes + 1
       Print #1, "New: " & Sheets("TEMPLATE").Name & "!" & AreaArray(A)
    Next A
    Range("C11").Select
    Sheets("TEMPLATE").Visible = False  'Hide template from users
    Close #1        'Close log
    MsgBox "Done with " & Changes & " address changes"
End Sub

By hand, this process was taking hours to perform and test. This required seconds!

© 2006-2017

Updated:  04/06/2017 20:32
This page added:  14 September 2006