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
Changes = 0
Open ThisWorkbook.Path & "\ChangeLog.TXT" For Output As #1
Workbooks("Tip_Summary.XLS").Activate
SheetArray = Array("200604", "200605", "200606", "200607", "200608", "200609")
AreaArray = Array("R9C6:R39C6", "R9C25:R39C25", "R9C15:R39C15", "R9C5:R39C5", "R9C24:R39C24", _
"R9C14:R39C14", "R9C7:R39C7", "R9C26:R39C26", "R9C16:R39C16")
ItemArray = Array("07110", "07120", "07130", "94110", "94120", _
"94130", "94140", "94150", "94160")
For Coun = LBound(SheetArray) To UBound(SheetArray)
Sheets(SheetArray(Coun)).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(SheetArray(Coun)).Name & "!R9C2:R39C2," & Sheets(SheetArray(Coun)).Name _
& "!" & AreaArray(A)
Changes = Changes + 1
Print #1, "New: " & Sheets(SheetArray(Coun)).Name & "!" & AreaArray(A)
Next A
Next Coun
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
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!
|