Mark
If I understand what you are after correctly this version will work.
Sub ExtractFormula()
Dim bAdd As Boolean
Dim iTxtLen As Integer
Dim i4Len As Integer
Dim l4Row As Long
Dim lLR As Long
Dim sCval As String
Dim sFormula As String
Dim sParam As String
Dim sOp As String
lLR = Cells(Rows.Count, "a").End(xlUp).Row
For l4Row = 1 To lLR Step 1
sCval = Cells(l4Row, "a")
iTxtLen = Len(sCval)
bAdd = True
For i4Len = 1 To iTxtLen Step 1
Select Case Mid(sCval, i4Len, 1)
Case "(", ")"
If Len(sOp) = 1 Then
sFormula = sFormula & sOp & sParam
sOp = vbNullString
Else
If Len(sParam) > 0 Then
Select Case sParam
Case "-", "+", "/", "*", "^"
sFormula = sFormula & sParam
Case Else
sFormula = sFormula & "*" & sParam
End Select
End If
End If
sParam = vbNullString
sFormula = sFormula & Mid(sCval, i4Len, 1)
bAdd = True
Case " "
bAdd = True
If Len(sParam) > 0 Then
Select Case sParam
Case "-", "+", "/", "*", "^"
sOp = sParam
Case Else
If Len(sOp) = 1 Then
sFormula = sFormula & sOp & sParam
sOp = vbNullString
Else
If Right(sFormula, 1) = "(" Then
sFormula = sFormula & sParam
Else
Select Case Left(sParam, 1)
Case "-", "+", "/", "*", "^"
sFormula = sFormula & sParam
Case Else
sFormula = sFormula & "*" & sParam
End Select
End If
End If
End Select
End If
sParam = vbNullString
Case Else
Select Case Mid(sCval, i4Len, 1)
Case "["
sParam = vbNullString
Case "]"
bAdd = False
Case Else
If bAdd = True Then
sParam = sParam & Mid(sCval, i4Len, 1)
End If
End Select
End Select
Next i4Len
If Len(sParam) > 0 Then
If Len(sOp) = 1 Then
sFormula = sFormula & sOp & sParam
Else
sFormula = sFormula & "*" & sParam
End If
End If
Cells(lLR + l4Row + 1, "a").Value = sFormula
sFormula = vbNullString
sOp = vbNullString
sParam = vbNullString
Next l4Row
End Sub
Bookmarks