K
KL
Hi Everyone,
Here is the challenge.
The task:
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
of the string, e.g. abadianocadpref1, abadianocadpref2, abadianocadpref3 ...
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.
Any ideas please?
Many thanks in advance,
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-------------
Here is the challenge.
The task:
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
of the string, e.g. abadianocadpref1, abadianocadpref2, abadianocadpref3 ...
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.
Any ideas please?
Many thanks in advance,
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-------------