Issue with array

E

EagleOne

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
 
E

EagleOne

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


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
Click to expand...
 
E

EagleOne

As always, the betterment revision.

BTW, to use, Activate (Select) a cell with a formula cell
that has two or more links in the formula. Run the macro.

Sub ParseMultipleLinkFormulas()
'
' EagleOne 4-20-2007
'
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 RParenthesis As Long
Dim LParenthesis 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
' Grouping Parantheses in formula may stop ihe process
'
LParenthesis = InStr(1, FormulaStr, "(")
If SecondLinkPosition - FirstLinkPosition > 0 Then
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
LParenthesis = InStr(PreviousPosition, Parsed(iCounter), "(")
RParenthesis = InStr(PreviousPosition, Mid(FormulaStr, _
PreviousPosition, fLength + 1 - PreviousPosition), ")")
If RParenthesis > PreviousPosition + Len(Parsed(iCounter)) Then
MsgBox "Can not parse formulas due to Parenthesis Grouping"
Exit Sub
End If
If iCounter = fLength Then
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 Then
With StartCell
.Formula = "=" & StartCell.Offset(2 + fCount + 1, 0).Address
.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










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
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

String array help - New to VBA 2
Reading a Range to an Array 10
Is it possible to create an sequestial ID for each Record 2
Converting VB to c# with bitwise operations 5
Help with VBA InStr() function 10
Array +fonction+vba 1
Dynamic multi-dimensional array 6
Loop to copy paste rows base on table arrays 0

Top