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


wrote:

2003/2007

My goal is to ID both the Position [OprPosition(iCounter)] and the actual Operator sign
[OprSign(Icounter)] in that position.

My Formula string is:
='3 Period Average EBITDA Summary'!H8+ _
'3 Period Average EBITDA Summary'!H22+ _
'3 Period Average EBITDA Summary'!H23

The string position of the first "+" in the formula is 38.

Ideally, I would like the array elements to be:
OprPosition(38) to equal 38 and
OprSign(38) to equal "+"
(to me meaning - in the immediate window ? OprPosition(38) yields 38
(and ? OprSign yields "+")

My logic is that that iCounter AND OprSign AND OprPosition are the same.
Is there a better way to do this??

Sub Test()

Dim p As Long
Dim s As Long
Dim iCounter As Long
'
Dim OprSign() As String
ReDim OprSign(1 To Len(ActiveCell.Formula)) As String
ReDim OprPosition(1 To Len(ActiveCell.Formula)) As Long
OprSigns = Array("+", "-", "*", "/", "^", "", "<", "<", "=", "<=")

For iCounter = 1 To Len(ActiveCell.Formula) Step 1
For s = 0 To 9
'p = InStr(iCounter, Mid(ActiveCell.Formula, iCounter, 1), OprSigns(s), vbTextCompare)
If Mid(ActiveCell.Formula, iCounter, 1) = OprSigns(s) Then
OprPosition(iCounter) = iCounter ' this works fine
OpSign(iCounter) = OprSigns(s) ' this does not work
'OpSign = OprSigns(s)
' = OprSigns(s)
End If
'OprPosition(pCounter) = OperSigns
Next s
Next iCounter
End With

End Sub


TIA EagleOne