covert only cell references in selected cells into value leaving the existingcell formula
Al,
Try this version.
I hope that "007" doesn't mean you have a license to kill.... ;-)
HTH,
Bernie
MS Excel MVP
Sub Convert3()
'Converts cell references to values within the
'Selected cell's formulas
'and spreads out cell references to the right
'of the cell with the formula
'Re-Written by Bernie Deitrick Jan 19, 2005
Dim strForm As String
Dim strOrig As String
Dim Addr As Variant
Dim Use() As Boolean
Dim i As Integer
Dim j As Integer
Dim myCell As Range
Dim mySel As Range
Dim myNum As Double
Dim KeepSource As Boolean
Const Operators As String = "=+-*/^()"
If MsgBox("Keep original formula intact?", vbYesNo) = vbYes Then
KeepSource = True
End If
For Each mySel In Selection
strForm = mySel.Formula
strOrig = mySel.Formula
For i = 1 To Len(Operators)
strForm = Replace(strForm, Mid(Operators, i, 1), "*")
Next i
Addr = Split(strForm, "*")
ReDim Use(LBound(Addr) To UBound(Addr))
For i = LBound(Addr) To UBound(Addr)
On Error GoTo NotNum:
myNum = CDbl(Addr(i))
Use(i) = True
NotNum:
Resume GoOn1
GoOn1:
Next i
For i = LBound(Addr) To UBound(Addr)
On Error GoTo NotCell
Set myCell = Range(Addr(i))
strOrig = Replace(strOrig, Addr(i), _
IIf(myCell.Value = "", "0", myCell.Value))
Use(i) = True
NotCell:
Resume GoOn2
GoOn2:
Next i
j = 1
For i = LBound(Addr) To UBound(Addr)
If Use(i) Then
mySel(1, j + 1).Formula = "=" & Addr(i)
j = j + 1
End If
Next i
If Not KeepSource Then mySel.Formula = strOrig
Next mySel
End Sub
"al007" wrote in message
oups.com...
Eg
If cell A1 from sheet 1 = Sheet2!D9+Sheet3!D3-Sheet4!B6
The macro would split A1 as:
B1 = Sheet2!D9
C1 = Sheet3!D3
D1 = -Sheet4!B6
the above is a simple example & should also provide for more complex
situation with * & /
& () like below
If cell A1 from sheet 1 = (Sheet2!D9+Sheet3!D3-Sheet4!B6)*2
The macro would split A1 as:
B1 = Sheet2!D9
C1 = Sheet3!D3
D1 = -Sheet4!B6
E1 = 2
is this do-able?
|