# Replacing Named Range Names By Cell References in Formulas

K

#### KL

Hi Everyone,

Here is the challenge.

in the cells containing formulas need to replace the names of the named
ranges by their actual range references e.g. MyName=\$A\$1:\$A\$10, old
formula=SUM(MyName), newformula=SUM(\$A\$1:\$A\$10). So far not big deal.

More Details:
- There are actually 6,764 (!) named ranges in the workbook. Please don't
ask me who, why and how did it, all I know it was done manually.
- There are 30 worksheets.
- There are 35,088 cells containing formalae.
- A number of names (but not all) use incremental numeric indices at the end
abadianocadpref30. The good news is that those indices have a maximum of 2
digits.

I wrote and successfully tested the below code without knowing the "More
details" part and it worked beautifully on my simulation worksheet. Of
course, now, knowing the dimensions of the task, I can no longer afford
parts 1 and 2 of the code. Actually, Part 3 doesn't seem to be reallistic
either given that it has to loop through 474,670,464 potential combinations
(35,088 x 6,764 x 2). The macro has been running for 4 hours now on my P4
1.8GHZ, 512MB RAM and I have no idea how much longer it will run.

KL

'------------Code Start-------------
Sub ReplaceNamesByRef()
Dim myList As String
Dim n As Name
Dim nn As Name
Dim Counter As Integer
Dim c As Range
Dim UserResponse
Dim msg As String

On Error Resume Next
If ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas).Count _
= 0 Then Exit Sub
On Error GoTo 0

'PART 1
For Each n In ThisWorkbook.Names
For Each nn In ThisWorkbook.Names
If InStr(nn.Name, n.Name) > 0 And nn.Name <> n.Name Then
myList = myList & "[" & nn.Name & "]" & _
" contains: " & "[" & n.Name & "]" & Chr(13)
Counter = Counter + 1
End If
Next nn
Next n

'PART 2
If Counter > 0 Then
msg = "The following problem has been detected:" _
& Chr(13) & Chr(13)
msg = msg & myList & Chr(13)
msg = msg & "Would you like to go ahead?" _
& Chr(13) & Chr(13)
msg = msg & "If you decide to go ahead, some names" _
& Chr(13)
msg = msg & "may be substituted incorrectly."

UserResponse = MsgBox(msg, vbYesNo + vbCritical)
If UserResponse = vbNo Then Exit Sub
Else
msg = "No duplicated names detected." _
& Chr(13) & Chr(13)
msg = msg & Chr(13) & _
"Would you like to go ahead?"

UserResponse = MsgBox(msg, vbYesNo + vbInformation)
If UserResponse = vbNo Then Exit Sub
End If

'PART 3
For Each c In ActiveSheet.Cells. _
SpecialCells(xlCellTypeFormulas)
With ThisWorkbook
For Each n In .Names
If n.Name Like "*##" Then
c.Formula = Replace(c.Formula, n.Name, _
Right(n.RefersTo, Len(n.RefersTo) - 1))
End If
Next n
For Each n In .Names
If n.Name Like "*#" Then
c.Formula = Replace(c.Formula, n.Name, _
Right(n.RefersTo, Len(n.RefersTo) - 1))
End If
Next n
End With
Next c
End Sub
'------------Code End-------------

Try this macro on one sheet and if it works okay, proceed to the others (or
modify it to work through the sheets on it's own).

Sub DenameFormulas()
Dim Cell As Range
ActiveSheet.TransitionFormEntry = True
For Each Cell In Cells.SpecialCells(xlFormulas)
Cell.Formula = Cell.Formula
Next
ActiveSheet.TransitionFormEntry = False
End Sub

--
Jim Rech
Excel MVP
"KL" <lapink2000(at)hotmail.com> wrote in message
| Hi Everyone,
|
| Here is the challenge.
|
| in the cells containing formulas need to replace the names of the named
| ranges by their actual range references e.g. MyName=\$A\$1:\$A\$10, old
| formula=SUM(MyName), newformula=SUM(\$A\$1:\$A\$10). So far not big deal.
|
| More Details:
| - There are actually 6,764 (!) named ranges in the workbook. Please don't
| ask me who, why and how did it, all I know it was done manually.
| - There are 30 worksheets.
| - There are 35,088 cells containing formalae.
| - A number of names (but not all) use incremental numeric indices at the
end
....
| abadianocadpref30. The good news is that those indices have a maximum of 2
| digits.
|
| I wrote and successfully tested the below code without knowing the "More
| details" part and it worked beautifully on my simulation worksheet. Of
| course, now, knowing the dimensions of the task, I can no longer afford
| parts 1 and 2 of the code. Actually, Part 3 doesn't seem to be reallistic
| either given that it has to loop through 474,670,464 potential
combinations
| (35,088 x 6,764 x 2). The macro has been running for 4 hours now on my P4
| 1.8GHZ, 512MB RAM and I have no idea how much longer it will run.
|
|
| KL
|
| '------------Code Start-------------
| Sub ReplaceNamesByRef()
| Dim myList As String
| Dim n As Name
| Dim nn As Name
| Dim Counter As Integer
| Dim c As Range
| Dim UserResponse
| Dim msg As String
|
| On Error Resume Next
| If ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas).Count _
| = 0 Then Exit Sub
| On Error GoTo 0
|
| 'PART 1
| For Each n In ThisWorkbook.Names
| For Each nn In ThisWorkbook.Names
| If InStr(nn.Name, n.Name) > 0 And nn.Name <> n.Name Then
| myList = myList & "[" & nn.Name & "]" & _
| " contains: " & "[" & n.Name & "]" & Chr(13)
| Counter = Counter + 1
| End If
| Next nn
| Next n
|
| 'PART 2
| If Counter > 0 Then
| msg = "The following problem has been detected:" _
| & Chr(13) & Chr(13)
| msg = msg & myList & Chr(13)
| msg = msg & "Would you like to go ahead?" _
| & Chr(13) & Chr(13)
| msg = msg & "If you decide to go ahead, some names" _
| & Chr(13)
| msg = msg & "may be substituted incorrectly."
|
| UserResponse = MsgBox(msg, vbYesNo + vbCritical)
| If UserResponse = vbNo Then Exit Sub
| Else
| msg = "No duplicated names detected." _
| & Chr(13) & Chr(13)
| msg = msg & Chr(13) & _
| "Would you like to go ahead?"
|
| UserResponse = MsgBox(msg, vbYesNo + vbInformation)
| If UserResponse = vbNo Then Exit Sub
| End If
|
| 'PART 3
| For Each c In ActiveSheet.Cells. _
| SpecialCells(xlCellTypeFormulas)
| With ThisWorkbook
| For Each n In .Names
| If n.Name Like "*##" Then
| c.Formula = Replace(c.Formula, n.Name, _
| Right(n.RefersTo, Len(n.RefersTo) - 1))
| End If
| Next n
| For Each n In .Names
| If n.Name Like "*#" Then
| c.Formula = Replace(c.Formula, n.Name, _
| Right(n.RefersTo, Len(n.RefersTo) - 1))
| End If
| Next n
| End With
| Next c
| End Sub
| '------------Code End-------------
|
|

Jim,

As simple as all genious is! Thank you very much in deed.

KL

Jim Rech said:
Try this macro on one sheet and if it works okay, proceed to the others
(or
modify it to work through the sheets on it's own).

Sub DenameFormulas()
Dim Cell As Range
ActiveSheet.TransitionFormEntry = True
For Each Cell In Cells.SpecialCells(xlFormulas)
Cell.Formula = Cell.Formula
Next
ActiveSheet.TransitionFormEntry = False
End Sub

--
Jim Rech
Excel MVP
"KL" <lapink2000(at)hotmail.com> wrote in message
| Hi Everyone,
|
| Here is the challenge.
|
| in the cells containing formulas need to replace the names of the named
| ranges by their actual range references e.g. MyName=\$A\$1:\$A\$10, old
| formula=SUM(MyName), newformula=SUM(\$A\$1:\$A\$10). So far not big deal.
|
| More Details:
| - There are actually 6,764 (!) named ranges in the workbook. Please
don't
| ask me who, why and how did it, all I know it was done manually.
| - There are 30 worksheets.
| - There are 35,088 cells containing formalae.
| - A number of names (but not all) use incremental numeric indices at the
end
...
| abadianocadpref30. The good news is that those indices have a maximum of
2
| digits.
|
| I wrote and successfully tested the below code without knowing the "More
| details" part and it worked beautifully on my simulation worksheet. Of
| course, now, knowing the dimensions of the task, I can no longer afford
| parts 1 and 2 of the code. Actually, Part 3 doesn't seem to be
reallistic
| either given that it has to loop through 474,670,464 potential
combinations
| (35,088 x 6,764 x 2). The macro has been running for 4 hours now on my
P4
| 1.8GHZ, 512MB RAM and I have no idea how much longer it will run.
|
|
| KL
|
| '------------Code Start-------------
| Sub ReplaceNamesByRef()
| Dim myList As String
| Dim n As Name
| Dim nn As Name
| Dim Counter As Integer
| Dim c As Range
| Dim UserResponse
| Dim msg As String
|
| On Error Resume Next
| If ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas).Count _
| = 0 Then Exit Sub
| On Error GoTo 0
|
| 'PART 1
| For Each n In ThisWorkbook.Names
| For Each nn In ThisWorkbook.Names
| If InStr(nn.Name, n.Name) > 0 And nn.Name <> n.Name Then
| myList = myList & "[" & nn.Name & "]" & _
| " contains: " & "[" & n.Name & "]" & Chr(13)
| Counter = Counter + 1
| End If
| Next nn
| Next n
|
| 'PART 2
| If Counter > 0 Then
| msg = "The following problem has been detected:" _
| & Chr(13) & Chr(13)
| msg = msg & myList & Chr(13)
| msg = msg & "Would you like to go ahead?" _
| & Chr(13) & Chr(13)
| msg = msg & "If you decide to go ahead, some names" _
| & Chr(13)
| msg = msg & "may be substituted incorrectly."
|
| UserResponse = MsgBox(msg, vbYesNo + vbCritical)
| If UserResponse = vbNo Then Exit Sub
| Else
| msg = "No duplicated names detected." _
| & Chr(13) & Chr(13)
| msg = msg & Chr(13) & _
| "Would you like to go ahead?"
|
| UserResponse = MsgBox(msg, vbYesNo + vbInformation)
| If UserResponse = vbNo Then Exit Sub
| End If
|
| 'PART 3
| For Each c In ActiveSheet.Cells. _
| SpecialCells(xlCellTypeFormulas)
| With ThisWorkbook
| For Each n In .Names
| If n.Name Like "*##" Then
| c.Formula = Replace(c.Formula, n.Name, _
| Right(n.RefersTo, Len(n.RefersTo) - 1))
| End If
| Next n
| For Each n In .Names
| If n.Name Like "*#" Then
| c.Formula = Replace(c.Formula, n.Name, _
| Right(n.RefersTo, Len(n.RefersTo) - 1))
| End If
| Next n
| End With
| Next c
| End Sub
| '------------Code End-------------
|
|