Option Explicit
Dim Results(10) As String
Dim Resultops(10) As String
Dim ops As String
Dim theformula As String
Dim dump As Integer
Dim dumpstr As String
Dim opsno As Integer
Sub formula_breakdown()
Dim max_char As Integer
Dim char_counter As Integer
Dim cell_str As String
Dim rCell As Range
For Each rCell In Cells.SpecialCells(xlCellTypeFormulas)
cell_str = rCell.Formula
max_char = Len(cell_str)
Call cellresult(cell_str, 1, max_char, 0)
dumpstr = "'"
For dump = 1 To 10
dumpstr = dumpstr & Results(dump) & Resultops(dump)
Next dump
rCell.Value = dumpstr
Next rCell
End Sub
Sub cellresult(cell_str As String, char_counter As Integer, max_char As Integer, resultcount As Integer)
If char_counter > max_char Then Exit Sub
ops = "*/+-"
For opsno = 1 To Len(ops)
If Mid(cell_str, char_counter, 1) = Mid(ops, opsno, 1) Then
resultcount = resultcount + 1
Range("a1000").Formula = Left(cell_str, char_counter - 1)
On Error GoTo formerror
Results(resultcount) = Range("a1000").Value
Resultops(resultcount) = " " & Mid(ops, opsno, 1) & " "
cell_str = "=" & Right(cell_str, max_char - char_counter)
max_char = Len(cell_str)
char_counter = 1
End If
Next opsno
If char_counter = max_char Then
resultcount = resultcount + 1
Range("a1000").Formula = Left(cell_str, char_counter)
On Error GoTo formerror
Results(resultcount) = Range("a1000").Value
Resultops(resultcount) = " End "
End If
char_counter = char_counter + 1
Call cellresult(cell_str, char_counter, max_char, resultcount)
Exit Sub
formerror:
Results(resultcount) = "Formula Error"
Resume Next
End Sub