Thanks Don for your assistance

If anyone has any improvements, please post back

Sub ParseMultipleLinkFormulas()
'
Dim iCounter As Long
Dim sCounter As Long
Dim fCount As Long
Dim fLength As Long
Dim FirstLinkPosition As Long
Dim SecondLinkPosition As Long
Dim PreviousPosition As Long
Dim AnyParenthesis As Long
Dim OprSign() As String
Dim Parsed() As String
Dim AggregateFormula As String
Dim FormulaStr As String
Dim OprPosition() As Long
Dim StartCell As Range
FormulaStr = ActiveCell.Formula
fLength = Len(FormulaStr)
ReDim OprSign(1 To fLength) As String
ReDim OprPosition(1 To fLength) As Long
ReDim Parsed(1 To fLength) As String
OprSigns = Array("+", "-", "*", "/", "^", "", "<", "<", "=", "<=")
FirstLinkPosition = InStr(1, FormulaStr, "'!")
SecondLinkPosition = InStr(FirstLinkPosition + 1, FormulaStr, "'!")
' Begins parsing only if there are two links in the formula and no
' grouping Parenthesis in the formulas
AnyParenthesis = InStr(1, FormulaStr, "(")
If SecondLinkPosition - FirstLinkPosition 0 Then
If AnyParenthesis 0 Then
MsgBox "Can not parse formulas due to Parenthesis Grouping"
End If
fCount = 0
PreviousPosition = 1
For iCounter = 1 To fLength Step 1
For sCounter = 0 To 9
If Mid(FormulaStr, iCounter, 1) = OprSigns(sCounter) Or iCounter = fLength Then
OprPosition(iCounter) = iCounter
OprSign(iCounter) = OprSigns(sCounter)
If fCount = 0 Then
Parsed(iCounter) = Mid(FormulaStr, PreviousPosition, _
IIf(iCounter fLength, fLength, iCounter - 1))
Else
Parsed(iCounter) = "=" & Mid(FormulaStr, PreviousPosition + 1, _
iCounter - IIf(iCounter < fLength, PreviousPosition + 1, _
fLength - PreviousPosition))
End If
If iCounter = fLength Then
'Stop
Exit For
End If
fCount = fCount + 1
PreviousPosition = IIf(iCounter fLength, fLength, iCounter)
End If
Next sCounter
Next iCounter
fCount = 0
Set StartCell = ActiveCell
AggregateFormula = "="
For iCounter = 1 To fLength Step 1
If Len(Parsed(iCounter)) 0 Then
With StartCell.Offset(2 + fCount, 0)
.Formula = Parsed(iCounter)
.NumberFormat = StartCell.NumberFormat
End With
AggregateFormula = AggregateFormula & StartCell.Offset(2 + fCount, 0).Address & _
IIf(iCounter = fLength, "", OprSign(iCounter))
fCount = fCount + 1
End If
Next iCounter
With StartCell.Offset(2 + fCount + 1, 0)
.Formula = AggregateFormula
.NumberFormat = StartCell.NumberFormat
End With
StartCell.Offset(2 + fCount + 1, 0).Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
End With
If StartCell.Value = StartCell.Offset(2 + fCount + 1, 0).Value + 1 Then
With StartCell
.Formula = AggregateFormula
.BorderAround LineStyle:=xlContinuous, ColorIndex:=5, Weight:=xlMedium
End With
'With StartCell.Offset(2 + fCount + 1, 0)
' .BorderAround LineStyle:=xlContinuous, ColorIndex:=5, Weight:=xlMedium
'End With
Else
With StartCell
.BorderAround LineStyle:=xlContinuous, ColorIndex:=3, Weight:=xlMedium
End With
With StartCell.Offset(2 + fCount + 1, 0)
.BorderAround LineStyle:=xlContinuous, ColorIndex:=3, Weight:=xlMedium
End With
MsgBox "The parsed formulas do not equal the starting formula"
End If

End If

End Sub



"Don Guillett" wrote:


or a for each math sign in a mid(i,1) loop