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