How in to parse constants in formula to cells

[EagleOne]

Ron,

Where is good source information on Regular Expressions? When you mentioned it previous I thought
you were referring to some subset of VBA.

EagleOne

 

[Guest]

Like you said before, it is probably not possible to adjust it for every
circumstances (Average(1,2,3) and so on...).

But it should pick up the negative values !
Any example where it failed to do so ?

I didn't allowed spaces in my first version, this Regexp shoud fix that:
re.Pattern = "[=(^*/+\-]\s*(-*\s*\d*\.?\d+)"


--
Regards,
Luc.

"Festina Lente"

Something like this ?

Sub extractConstants()
Dim range_to_check As Range
Dim re As New RegExp
Dim matches, match, i, c

Set range_to_check = [A1:A4] ' SET AS NEEDED

re.Global = True
re.Pattern = "[=(^*/+\-](-*\d*\.?\d+)"
For Each c In range_to_check
Set matches = re.Execute(c.Formula)
For Each match In matches
i = i + 1
Debug.Print i, match, match.SubMatches(0)
Next
Next
End Sub

Nice regex. I was trying to think of something like that but could not.

But it fails on formulas such as:

=AVERAGE(1,2,3)

It also fails to return the negative values, as the OP mentioned in a
subsequent post.


--ron

 

[Ron Rosenfeld]

Like you said before, it is probably not possible to adjust it for every
circumstances (Average(1,2,3) and so on...).

But it should pick up the negative values !
Any example where it failed to do so ?

I didn't allowed spaces in my first version, this Regexp shoud fix that:
re.Pattern = "[=(^*/+\-]\s*(-*\s*\d*\.?\d+)"

On the OP's first example:

1 =687319 687319
2 +523187 523187
3 -7344000 7344000
4 +758450 758450
5 +2232642 2232642
6 +1995819 1995819
7 -2721538 2721538
8 +1491693 1491693
9 +723564 723564
10 *3 3

Note that the results or your routine are unsigned.

In my algorithm, I handled that problem differently, and so was able to retain
the negative signs.

1 687319
2 523187
3 -7344000
4 758450
5 2232642
6 1995819
7 -2721538
8 1491693
9 723564
10 3


--ron

 

[Ron Rosenfeld]

Like you said before, it is probably not possible to adjust it for every
circumstances (Average(1,2,3) and so on...).

But it should pick up the negative values !
Any example where it failed to do so ?

I didn't allowed spaces in my first version, this Regexp shoud fix that:
re.Pattern = "[=(^*/+\-]\s*(-*\s*\d*\.?\d+)"

Here's another simple function where your routine does not pick up anything:

=IF(G1>10000,C1,-10)

My approach picks up both:

1 10000
2 -10




--ron

 

[Ron Rosenfeld]

Note that the results or your routine are unsigned

That should read:

Note that the results of your routine are unsigned

--ron

 

[Guest]

LOL
That's a peculiar way to define a negative constant !
So X-Y means that Y is negative ?

Seriously, if that's what the OP wanted it could easily be fixed.
The "within string" occurences may very well be a problem too like in
MID("attention=2*too low",1,1)
--
Regards,
Luc.

"Festina Lente"

Like you said before, it is probably not possible to adjust it for every
circumstances (Average(1,2,3) and so on...).

But it should pick up the negative values !
Any example where it failed to do so ?

I didn't allowed spaces in my first version, this Regexp shoud fix that:
re.Pattern = "[=(^*/+\-]\s*(-*\s*\d*\.?\d+)"

On the OP's first example:

1 =687319 687319
2 +523187 523187
3 -7344000 7344000
4 +758450 758450
5 +2232642 2232642
6 +1995819 1995819
7 -2721538 2721538
8 +1491693 1491693
9 +723564 723564
10 *3 3

Note that the results or your routine are unsigned.

In my algorithm, I handled that problem differently, and so was able to retain
the negative signs.

1 687319
2 523187
3 -7344000
4 758450
5 2232642
6 1995819
7 -2721538
8 1491693
9 723564
10 3


--ron

 

[Guest]

I think you should accept to match every "constants", even the "2" in
ROUND(a1,2).
Filtering out those is just about impossible...

Another problem, do we need to ignore string content, like in
=MID("this formula is 2*-3^PI",1,1)
??

And do you really want the results
2
-3
from
=A1+2-3
and not
2
3
??

 

[Ron Rosenfeld]

LOL
That's a peculiar way to define a negative constant !
So X-Y means that Y is negative ?

Seriously, if that's what the OP wanted it could easily be fixed.

This is what the OP wrote:
_______________________________________________________________________

"Because I changed the operational signs to "~" I have lost positive vs
negative numbers.

"Can you think of a way to preserve the positive vs negative numbers?"
_________________________________________________________________________

The "within string" occurences may very well be a problem too like in
MID("attention=2*too low",1,1)

Easily fixed if "within string" occurrences of numbers should be ignored.

In my algorithm, I would merely eliminate all within quotes, including the
quotes, by adding to my Ignore regex.


--ron

 

[Guest]

One more thing, how about percentages (%) ?
What should be the results from
=A1*3%
=A1%

 

[Guest]

The OP's routine would eliminate the negative from
=a1*-3
but I am not sure what he wants exactly from
=A1-3
....

 

[Ron Rosenfeld]

2003

If I have a "formulas" like:
=687319+523187-7344000+758450+2232642+1995819-2721538+1491693+723564+(A1*3) 'Need all constants
including the "3" in (A1*3) parsed to cells Z1 thru Z10

-or-

=Round(A1*0.035) ' Need the.35 parsed to Z11

-or-

=P39/$C40*12-P39 'Need the "12" parsed to Z13

-or-

=1000/2 Need 1000 parsed to Z14 and 2 parsed to Z15

I have thought of Cells.Find; Mid(), but what is the smartest lines of VBA code to evaluate formulas
for constants whether + - * / and then parse those constants to cells elsewhere on the w/s?

TIA EagleOne

Here's a somewhat cleaned up and better annotated version.

With regard to some of the issues:
it returns the negative signed values
it does NOT return "within string" constants
it returns 3% as 3
it returns all constants within a function
the output goes into the cells to the right of "selection"


============================================
Option Explicit
Sub ParseFormula()
'set up Regex
Dim objRegExp As RegExp
Dim objMatch As match
Dim colMatches As MatchCollection

' Create a regular expression object.
Set objRegExp = New RegExp
' Set Case Insensitivity.
objRegExp.IgnoreCase = True
'Set global applicability.
objRegExp.Global = True

Dim FormulaText As String
Const CellRef As String = "\$?[A-Z]{1,2}\$?\d{1,5}"
Const Operator As String = "[/*^&()=<>,+]" 'No "-"
Const WithinString As String = """[^""]*"""
Const NumConstant As String = "-?(\d*\.)?\d+"
Dim Ignore As String
Dim i As Long
Dim c As Range

Ignore = Join(Array(WithinString, CellRef, Operator), "|")

'set the Regex pattern to replace unwanted stuff
objRegExp.pattern = Join(Array(WithinString, CellRef, Operator), "|")

For Each c In Selection
FormulaText = c.Formula

'Test whether the String can be compared.
If (objRegExp.Test(FormulaText) = True) Then

'change - to +- to retain negative signage
FormulaText = Replace(FormulaText, "-", "+-")

'replace unwanted stuff
objRegExp.pattern = Ignore
FormulaText = objRegExp.Replace(FormulaText, "~")

'Get the matches.
objRegExp.pattern = NumConstant
Set colMatches = objRegExp.Execute(FormulaText) ' Execute search.

End If

'Output for testing, but could go into any range
i = 1
For Each objMatch In colMatches
c.Offset(0, i).Value = objMatch
i = i + 1
Next objMatch

Next c

End Sub
===============================
--ron

 

[EagleOne]

Ron & PapaDos,

After using the different routines, and if I may be so bold:

What works best is that the output should be pure constants used to change cell values and not
"constants" within functions. The reason that I added (A1*3) was to make sure that I could get to
the multiplier "3" [when the OP used parenthesis to make the formula more obvious].

Actually, it would be best for the routine to ignore within-function arguements or settings.

Specifically, any numbers added, subtracted, divided, multiplied

Users have a bad habit of not identifying the pieces-parts of cell values, i.e.
Sales A Division 687319
Sales B Division 523187
Expenses A Division -7344000
Sales A Division 758450
etc, etc

My plan is to place the output of your routines into separate cells on a new worksheet so that each
constant is completely separated ready to be properly labeled and identified.

Therefore, I need to be able to

1) spin out all constants which are effectively hidden in formula strings (but not within functions
or worksheet links etc)
2) Spin any included function or link out to the same worksheet as a string

Sales A Division 687319
Sales B Division 523187
Expenses A Division -7344000
Sales A Division 758450
etc, etc xxxxxx
'='Sheet1'!A2 999000
Total xxxxxxxxxx
[This total should equal
the displayed value in
the active cell )

I have no references nor information on how to modify/create Regular Expressions

Thanks so much for you time and knowledge

EagleOne

 

[Ron Rosenfeld]

1) spin out all constants which are effectively hidden in formula strings (but not within functions
or worksheet links etc)

So, with regard to the formula:

=ROUND(0.035,1)

what, exactly do you want?

And the references (I'm not sure why they did not come through earlier):


http://www.regular-expressions.info/reference.html
http://support.microsoft.com/default.aspx?scid=kb;en-us;818802&Product=vbb
http://msdn.microsoft.com/library/d...html/2380d458-3366-402b-996c-9363906a7353.asp



--ron

 

[EagleOne]

Ron,

For ROUND(0.035,1) I do not need either of those constants nor do I need the constants in
Average[1,2,3]

Maybe another way to thing of it might me only the full string of numbers after each operator and
the equal sign like "+/-=*". I believe that will give me just the constants which should have been
in a summed worksheet list with labels.

It gets a bit more dicey when IF(X>0, A1*3,A1). In this case, I want the 3 but not the 0. But the
3 should be picked up by "the full string of numbers after each operator"

What I realized later is that if the formula had four constants and a link, then a sum of all of the
constants would not add up to the original cell value in this case.

The correct cell value would be the sum of the four constants AND the value of the linked cell.

Because this gets real complicated, I thought that if all functions and the with-in constants would
be appended to the list as its own label ROUND(999.99,2).

Therefore,
= 1+2+3+4+Round(999.99,2) 'Would yield

Description
Item A 1
Item B 2
Item C 3
Item D 4
'Round(999.99,2) 1000 'if complicated to ascertain function's value, leave the value blank
Total 1010

Hopefully, I am clearer now. I'll be close by for the next 6 hours.

 

[Ron Rosenfeld]

On Mon, 27 Nov 2006 18:11:58 GMT, (e-mail address removed) wrote:

We're getting closer to defining what you want.

Ron,

For ROUND(0.035,1) I do not need either of those constants nor do I need the constants in
Average[1,2,3]

Maybe another way to thing of it might me only the full string of numbers after each operator and
the equal sign like "+/-=*". I believe that will give me just the constants which should have been
in a summed worksheet list with labels.

It gets a bit more dicey when IF(X>0, A1*3,A1). In this case, I want the 3 but not the 0. But the
3 should be picked up by "the full string of numbers after each operator"

What I realized later is that if the formula had four constants and a link, then a sum of all of the
constants would not add up to the original cell value in this case.

The correct cell value would be the sum of the four constants AND the value of the linked cell.

Because this gets real complicated, I thought that if all functions and the with-in constants would
be appended to the list as its own label ROUND(999.99,2).

Therefore,
= 1+2+3+4+Round(999.99,2) 'Would yield

Description
Item A 1
Item B 2
Item C 3
Item D 4
'Round(999.99,2) 1000 'if complicated to ascertain function's value, leave the value blank
Total 1010

Hopefully, I am clearer now. I'll be close by for the next 6 hours.

Aside from the fact that ROUND(999.99,2) --> 999.99 and not 1000, there remains
a problem in differentiating functions from which you want to extract constants
from those you don't wish to execute an extraction.

IF(X>0,A1*3,A1)

you write extract the 3 using the "number string after operator algorithm"/

BUT that fails with

IF(X>0,3*A1,A1)

or even

IF(X>0,3,1)

==========================================

It seems to me it would be a whole lot simpler to develop a user form that
would ensure that entries are made properly.




--ron

 

[EagleOne]

Ron,

Included is the current form of your code. I used this all day and it works astoundingly well. The
other issues I was able to obtain from alternate sources.

Thank you for your time, efforts and knowledge.

I must learn much more about Regular Expressions. It really continues where VBA is weak.

Can you provide me with links to the best Regular Expressions sites?

EagleOne


************************************************************************************************************
Sub ParseFormula()
'From: Ron Rosenfeld <[email protected]>
'Subject: Re: How in to parse constants in formula to cells
'Date: Mon, 27 Nov 2006 09:05:29 -0500
'Newsgroups: microsoft.public.Excel.programming 'With regard to some of the issues:
' it returns the negative signed values
' it does NOT return "within string" constants
' it returns 3% as 3
' it returns all constants within a function
' the output goes into the cells to the right of "selection"

'set up Regex
Dim objRegExp As RegExp
Dim objMatch As match
Dim colMatches As MatchCollection

' Create a regular expression object.
Set objRegExp = New RegExp
' Set Case Insensitivity.
objRegExp.IgnoreCase = True
' Set global applicability.
objRegExp.Global = True

Dim FormulaText As String
Const CellRef As String = "\$?[A-Z]{1,2}\$?\d{1,5}"
Const Operator As String = "[/*^&()=<>,+]" 'No "-"
Const WithinString As String = """[^""]*"""
Const NumConstant As String = "-?(\d*\.)?\d+"
Dim OriginalFormula As String
Dim Ignore As String
Dim OrigFormula As String
Dim i As Long
Dim c As Range
Dim myRange As Range

If Not WorksheetExists("Constants in Formulas", ActiveWorkbook) Then
MsgBox "There is no Constants in Formulas" & Chr(10) & "Worksheet in this Workbook"
Exit Sub
End If
If WorksheetExists("Constants Input", ActiveWorkbook) Then
Application.DisplayAlerts = False
Sheets("Constants Input").Delete
Application.DisplayAlerts = True
End If
Sheets.Add.Name = "Constants Input"
Sheets("Constants Input").Move After:=Worksheets("Constants In Formulas")
With Sheets("Constants Input")
.Range("A1").Value = "DESCRIPTION"
.Range("B1").Value = "SHEET"
.Range("C1").Value = "ADDRESS"
.Range("D1").Value = "AMOUNT"
.Range("E1").Value = "REPLACEMENT"
With .Range("A1:E1")
.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideVertical).Weight = xlMedium
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
If Not WorksheetExists("Links in Formulas", ActiveWorkbook) Then
MsgBox "NOTE: There is no Formula Links" & Chr(10) & "Worksheet in this Workbook"
End If
Ignore = Join(Array(WithinString, CellRef, Operator), "|")

' set the Regex pattern to replace unwanted stuff
objRegExp.Pattern = Join(Array(WithinString, CellRef, Operator), "|")

'i = 0
Set myRange = Sheets("Constants in Formulas").Range("F2:F" & _
Sheets("Constants In Formulas").Cells(Rows.count, "D").End(xlUp).Row)
i = Sheets("Constants Input").Cells(Rows.count, "D").End(xlUp)(2).Row
'For Each c In Selection
For Each c In myRange
OrigFormula = c.Formula
FormulaText = c.Formula

' Test whether the String can be compared.
If (objRegExp.Test(FormulaText) = True) Then

' change - to +- to retain negative signage
FormulaText = Replace(FormulaText, "-", "+-")

' replace unwanted stuff
objRegExp.Pattern = Ignore
FormulaText = objRegExp.Replace(FormulaText, "~")

' Get the matches.
objRegExp.Pattern = NumConstant
Set colMatches = objRegExp.Execute(FormulaText) ' Execute search.

End If

' Output for testing, but could go into any range
' i = 1
For Each objMatch In colMatches
'c.Offset(0, i).Value = objMatch
With Sheets("Constants Input").Range("D" & i)
.Offset(0, 0).Value = objMatch 'Amount
.Offset(0, -2) = c.Offset(0, -4).Value 'Sheetname
.Offset(0, -1) = c.Offset(0, -3).Value 'Cell address
.Offset(0, 1).Hyperlinks.Add Anchor:=.Offset(0, 1), _
Address:="", SubAddress:="'" + c.Offset(0, -4).Value + "'!" + _
Replace(c.Offset(0, -3).Value, "$", ""), _
TextToDisplay:=c.Offset(0, -3).Value
End With
If InStr(1, OrigFormula, "!") > 0 Then
Sheets("Constants Input").Range("D" & i).Offset(0, 0).Interior.ColorIndex = 6
End If
i = i + 1
Next objMatch
i = i + 2
Next c
Set myRange = Sheets("Constants Input").Range("D2:E" & _
Sheets("Constants Input").Cells(Rows.count, "D").End(xlUp).Row)
myRange.Value = myRange.Value 'Changes or Resets numbers formated as text to numbers
myRange.NumberFormat = "#,##0.00_);(#,##0.00)" 'Number 2 Dec Places
'myRange.Replace What:=Chr(160), Replacement:=Chr(32), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False ' Not necessary
Sheets("Constants Input").Cells.Columns.AutoFit
Sheets("Constants Input").Range("A1").Select
MsgBox "Process Completed! Press OK to Continue"

End Sub

On Mon, 27 Nov 2006 18:11:58 GMT, (e-mail address removed) wrote:

We're getting closer to defining what you want.

Ron,

For ROUND(0.035,1) I do not need either of those constants nor do I need the constants in
Average[1,2,3]

Maybe another way to thing of it might me only the full string of numbers after each operator and
the equal sign like "+/-=*". I believe that will give me just the constants which should have been
in a summed worksheet list with labels.

It gets a bit more dicey when IF(X>0, A1*3,A1). In this case, I want the 3 but not the 0. But the
3 should be picked up by "the full string of numbers after each operator"

What I realized later is that if the formula had four constants and a link, then a sum of all of the
constants would not add up to the original cell value in this case.

The correct cell value would be the sum of the four constants AND the value of the linked cell.

Because this gets real complicated, I thought that if all functions and the with-in constants would
be appended to the list as its own label ROUND(999.99,2).

Therefore,
= 1+2+3+4+Round(999.99,2) 'Would yield

Description
Item A 1
Item B 2
Item C 3
Item D 4
'Round(999.99,2) 1000 'if complicated to ascertain function's value, leave the value blank
Total 1010

Hopefully, I am clearer now. I'll be close by for the next 6 hours.

Aside from the fact that ROUND(999.99,2) --> 999.99 and not 1000, there remains
a problem in differentiating functions from which you want to extract constants
from those you don't wish to execute an extraction.

IF(X>0,A1*3,A1)

you write extract the 3 using the "number string after operator algorithm"/

BUT that fails with

IF(X>0,3*A1,A1)

or even

IF(X>0,3,1)

==========================================

It seems to me it would be a whole lot simpler to develop a user form that
would ensure that entries are made properly.




--ron

 

[Ron Rosenfeld]

Ron,

Included is the current form of your code. I used this all day and it works astoundingly well. The
other issues I was able to obtain from alternate sources.

Thank you for your time, efforts and knowledge.

I must learn much more about Regular Expressions. It really continues where VBA is weak.

Can you provide me with links to the best Regular Expressions sites?

EagleOne

Well I'm glad I was able to help you with your problem. Thanks for the
feedback.

The web references I use are:

http://www.regular-expressions.info/reference.html
http://support.microsoft.com/default.aspx?scid=kb;en-us;818802&Product=vbb
http://msdn.microsoft.com/library/d...html/2380d458-3366-402b-996c-9363906a7353.asp


I would also recommend: Jeffrey Friedl's book 'Mastering Regular Expressions,
2nd Ed.', ISBN 0-596-00289-0.

It was recommended to me by Harlan Grove. And I was able to obtain a used
version on Amazon.com for just a few dollars. It's very good.

Best wishes,
--ron

 

[Dennis]

Ron,

If you are still in the mood. Attached is some code that I am
currently using for a huge project and the deadline is tomorrow..

The code is part of the same project with which you helped me earlier.
Here is my whine with cheese.

The code works fine until I attempt to replace i.e. a "2" in formulas
where there are multiple "2's". a specific example is: =4237987/2 or
=122335/2. What I want to replace is the 2 after the operator "/"
(where the 2 is the ENTIRE NUMBER after ANY operator. I think that
those parameters will keep me out of trouble.

Currently, I trap that error and "mark" the cell for manual followup
later.

Would you please help me to devise a few code lines to change/add to my
code that will fix this challenge?

The code follows:

Sub ReplaceConstant()
Dim MyCell As Range
Dim myRange As Range
Dim Filter1 As Range
Dim NumToSearch As Double
Dim NumbCriteria As String

If Sheets("Constants Input").AutoFilterMode = True Then
Sheets("Constants Input").UsedRange.AutoFilter
End If
Do While NumToSearch = 0
NumToSearch = _
InputBox("Enter number to replace", "Replace Entry Box")
If NumToSearch = 0 Then
MsgBox "No Number Entered ... Start Over"
End If
Loop
NumbCriteria = WorksheetFunction.Text(NumToSearch, _
"#,##0.00_);(#,##0.00)")
Set Filter1 = Sheets("Constants Input").Range("A1:F" & _
Cells(Rows.Count, "D").End(xlUp).Row)
'Filter1.Range("D:E").NumberFormat = "#,##0.00_);(#,##0.00)"
Filter1.AutoFilter Field:=2, Criteria1:="<>"
Filter1.AutoFilter Field:=4, Criteria1:="=" & NumbCriteria
Set myRange = Intersect(Sheets("Constants Input").Range("B2:B" _
& Cells(Rows.Count, "D").End(xlUp).Row). _
SpecialCells(xlCellTypeVisible), _
Sheets("Constants Input").Range("B2:B" & _
Cells(Rows.Count, "D").End(xlUp).Row). _
SpecialCells(xlConstants))
For Each MyCell In myRange
If Len(MyCell.Offset(0, 3).Formula) = 0 Then
MsgBox "Not all Replacements are entered!!!"
Exit Sub
End If
MyCell.Offset(0, 3).Formula = myRange(1).Offset(0, 3).Formula
Application.GoTo Reference:= _
Worksheets(MyCell.Offset(0, 0).Value). _
Range(MyCell.Offset(0, 1).Value)
On Error Resume Next
'****************** The error occurs here!! **********************
ActiveCell.Formula = Replace(ActiveCell.Formula, NumToSearch, _
Replace(MyCell.Offset(0, 3).Formula, "=", ""))
If Err.Number > 0 Then
MyCell.Offset(0, 3).Interior.ColorIndex = 3
ActiveCell.Interior.ColorIndex = 3
On Error GoTo 0
Else
ActiveCell.Interior.ColorIndex = 43
End If
'********************************************************************
myRange(1).Offset(0, 3).Interior.ColorIndex = 4
Next MyCell
ActiveWindow.Zoom = 75
Sheets("Constants Input").Activate
Range(myRange(1).Address).Select
Cells.Columns.AutoFit
MsgBox "Process Completed! Press OK to Continue"

End Sub

Ron,

Included is the current form of your code. I used this all day and it works astoundingly well. The
other issues I was able to obtain from alternate sources.

Thank you for your time, efforts and knowledge.

I must learn much more about Regular Expressions. It really continues where VBA is weak.

Can you provide me with links to the best Regular Expressions sites?

EagleOne


************************************************************************************************************
Sub ParseFormula()
'From: Ron Rosenfeld <[email protected]>
'Subject: Re: How in to parse constants in formula to cells
'Date: Mon, 27 Nov 2006 09:05:29 -0500
'Newsgroups: microsoft.public.Excel.programming 'With regard to some of the issues:
' it returns the negative signed values
' it does NOT return "within string" constants
' it returns 3% as 3
' it returns all constants within a function
' the output goes into the cells to the right of "selection"

'set up Regex
Dim objRegExp As RegExp
Dim objMatch As match
Dim colMatches As MatchCollection

' Create a regular expression object.
Set objRegExp = New RegExp
' Set Case Insensitivity.
objRegExp.IgnoreCase = True
' Set global applicability.
objRegExp.Global = True

Dim FormulaText As String
Const CellRef As String = "\$?[A-Z]{1,2}\$?\d{1,5}"
Const Operator As String = "[/*^&()=<>,+]" 'No "-"
Const WithinString As String = """[^""]*"""
Const NumConstant As String = "-?(\d*\.)?\d+"
Dim OriginalFormula As String
Dim Ignore As String
Dim OrigFormula As String
Dim i As Long
Dim c As Range
Dim myRange As Range

If Not WorksheetExists("Constants in Formulas", ActiveWorkbook) Then
MsgBox "There is no Constants in Formulas" & Chr(10) & "Worksheet in this Workbook"
Exit Sub
End If
If WorksheetExists("Constants Input", ActiveWorkbook) Then
Application.DisplayAlerts = False
Sheets("Constants Input").Delete
Application.DisplayAlerts = True
End If
Sheets.Add.Name = "Constants Input"
Sheets("Constants Input").Move After:=Worksheets("Constants In Formulas")
With Sheets("Constants Input")
.Range("A1").Value = "DESCRIPTION"
.Range("B1").Value = "SHEET"
.Range("C1").Value = "ADDRESS"
.Range("D1").Value = "AMOUNT"
.Range("E1").Value = "REPLACEMENT"
With .Range("A1:E1")
.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideVertical).Weight = xlMedium
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
If Not WorksheetExists("Links in Formulas", ActiveWorkbook) Then
MsgBox "NOTE: There is no Formula Links" & Chr(10) & "Worksheet in this Workbook"
End If
Ignore = Join(Array(WithinString, CellRef, Operator), "|")

' set the Regex pattern to replace unwanted stuff
objRegExp.Pattern = Join(Array(WithinString, CellRef, Operator), "|")

'i = 0
Set myRange = Sheets("Constants in Formulas").Range("F2:F" & _
Sheets("Constants In Formulas").Cells(Rows.count, "D").End(xlUp).Row)
i = Sheets("Constants Input").Cells(Rows.count, "D").End(xlUp)(2).Row
'For Each c In Selection
For Each c In myRange
OrigFormula = c.Formula
FormulaText = c.Formula

' Test whether the String can be compared.
If (objRegExp.Test(FormulaText) = True) Then

' change - to +- to retain negative signage
FormulaText = Replace(FormulaText, "-", "+-")

' replace unwanted stuff
objRegExp.Pattern = Ignore
FormulaText = objRegExp.Replace(FormulaText, "~")

' Get the matches.
objRegExp.Pattern = NumConstant
Set colMatches = objRegExp.Execute(FormulaText) ' Execute search.

End If

' Output for testing, but could go into any range
' i = 1
For Each objMatch In colMatches
'c.Offset(0, i).Value = objMatch
With Sheets("Constants Input").Range("D" & i)
.Offset(0, 0).Value = objMatch 'Amount
.Offset(0, -2) = c.Offset(0, -4).Value 'Sheetname
.Offset(0, -1) = c.Offset(0, -3).Value 'Cell address
.Offset(0, 1).Hyperlinks.Add Anchor:=.Offset(0, 1), _
Address:="", SubAddress:="'" + c.Offset(0, -4).Value + "'!" + _
Replace(c.Offset(0, -3).Value, "$", ""), _
TextToDisplay:=c.Offset(0, -3).Value
End With
If InStr(1, OrigFormula, "!") > 0 Then
Sheets("Constants Input").Range("D" & i).Offset(0, 0).Interior.ColorIndex = 6
End If
i = i + 1
Next objMatch
i = i + 2
Next c
Set myRange = Sheets("Constants Input").Range("D2:E" & _
Sheets("Constants Input").Cells(Rows.count, "D").End(xlUp).Row)
myRange.Value = myRange.Value 'Changes or Resets numbers formated as text to numbers
myRange.NumberFormat = "#,##0.00_);(#,##0.00)" 'Number 2 Dec Places
'myRange.Replace What:=Chr(160), Replacement:=Chr(32), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False ' Not necessary
Sheets("Constants Input").Cells.Columns.AutoFit
Sheets("Constants Input").Range("A1").Select
MsgBox "Process Completed! Press OK to Continue"

End Sub

On Mon, 27 Nov 2006 18:11:58 GMT, (e-mail address removed) wrote:

We're getting closer to defining what you want.

Ron,

For ROUND(0.035,1) I do not need either of those constants nor do I need the constants in
Average[1,2,3]

Maybe another way to thing of it might me only the full string of numbers after each operator and
the equal sign like "+/-=*". I believe that will give me just the constants which should have been
in a summed worksheet list with labels.

It gets a bit more dicey when IF(X>0, A1*3,A1). In this case, I want the 3 but not the 0. But the
3 should be picked up by "the full string of numbers after each operator"

What I realized later is that if the formula had four constants and a link, then a sum of all of the
constants would not add up to the original cell value in this case.

The correct cell value would be the sum of the four constants AND the value of the linked cell.

Because this gets real complicated, I thought that if all functions and the with-in constants would
be appended to the list as its own label ROUND(999.99,2).

Therefore,
= 1+2+3+4+Round(999.99,2) 'Would yield

Description
Item A 1
Item B 2
Item C 3
Item D 4
'Round(999.99,2) 1000 'if complicated to ascertain function's value, leave the value blank
Total 1010

Hopefully, I am clearer now. I'll be close by for the next 6 hours.

Aside from the fact that ROUND(999.99,2) --> 999.99 and not 1000, there remains
a problem in differentiating functions from which you want to extract constants
from those you don't wish to execute an extraction.

IF(X>0,A1*3,A1)

you write extract the 3 using the "number string after operator algorithm"/

BUT that fails with

IF(X>0,3*A1,A1)

or even

IF(X>0,3,1)

==========================================

It seems to me it would be a whole lot simpler to develop a user form that
would ensure that entries are made properly.




--ron

 

[Ron Rosenfeld]

Ron,

If you are still in the mood. Attached is some code that I am
currently using for a huge project and the deadline is tomorrow..

The code is part of the same project with which you helped me earlier.
Here is my whine with cheese.

The code works fine until I attempt to replace i.e. a "2" in formulas
where there are multiple "2's". a specific example is: =4237987/2 or
=122335/2. What I want to replace is the 2 after the operator "/"
(where the 2 is the ENTIRE NUMBER after ANY operator. I think that
those parameters will keep me out of trouble.

Currently, I trap that error and "mark" the cell for manual followup
later.

Would you please help me to devise

Well, the simplest way (for me) to do that sort of replacement is by using
Regular Expressions. The routines work quicker if you set a reference to
Microsoft VBScrip REgular Expressions 5.5 (See Tools/References), but you can
also use the CreateObject method to set his within the script.

The "key" as to what is going to be replaced is in how you define "Pattern".
As set up, the "\b" parameter refers to any word boundary, which could be an
operator, comma, or any character that is not alphanumeric, or the beginning or
end of the string.

If that doesn't work, and you must test for ONLY operators, then change two
lines:

Pattern = "([-+/*])" & NumToReplace & "\b"

FormulaText = objRegExp.Replace(FormulaText, "$1" & ReplWith)

================================
Option Explicit

Sub replConstant()
Dim FormulaText As String
Const NumToReplace = 2
Const ReplWith = 4
Dim Pattern As String

Dim objRegExp As RegExp
Dim objMatch As Match
Dim colMatches As MatchCollection

Pattern = "\b" & NumToReplace & "\b"
FormulaText = Selection.Formula

' Create a regular expression object.
Set objRegExp = New RegExp

'Set the pattern by using the Pattern property.
objRegExp.Pattern = Pattern

' Set Case Insensitivity.
objRegExp.IgnoreCase = True

'Set global applicability.
objRegExp.Global = True

'Test whether the String can be compared.
If (objRegExp.Test(FormulaText) = True) Then

'Do the replacement
FormulaText = objRegExp.Replace(FormulaText, ReplWith)

Debug.Print FormulaText

End If

End Sub
================================

Hope this helps


--ron

 

[Dennis]

After work today, I'll take a look at the code you sent.

Your help has been a God-send for me this week.

Eagle-one

Ron,

If you are still in the mood. Attached is some code that I am
currently using for a huge project and the deadline is tomorrow..

The code is part of the same project with which you helped me earlier.
Here is my whine with cheese.

The code works fine until I attempt to replace i.e. a "2" in formulas
where there are multiple "2's". a specific example is: =4237987/2 or
=122335/2. What I want to replace is the 2 after the operator "/"
(where the 2 is the ENTIRE NUMBER after ANY operator. I think that
those parameters will keep me out of trouble.

Currently, I trap that error and "mark" the cell for manual followup
later.

Would you please help me to devise

Well, the simplest way (for me) to do that sort of replacement is by using
Regular Expressions. The routines work quicker if you set a reference to
Microsoft VBScrip REgular Expressions 5.5 (See Tools/References), but you can
also use the CreateObject method to set his within the script.

The "key" as to what is going to be replaced is in how you define "Pattern".
As set up, the "\b" parameter refers to any word boundary, which could be an
operator, comma, or any character that is not alphanumeric, or the beginning or
end of the string.

If that doesn't work, and you must test for ONLY operators, then change two
lines:

Pattern = "([-+/*])" & NumToReplace & "\b"

FormulaText = objRegExp.Replace(FormulaText, "$1" & ReplWith)

================================
Option Explicit

Sub replConstant()
Dim FormulaText As String
Const NumToReplace = 2
Const ReplWith = 4
Dim Pattern As String

Dim objRegExp As RegExp
Dim objMatch As Match
Dim colMatches As MatchCollection

Pattern = "\b" & NumToReplace & "\b"
FormulaText = Selection.Formula

' Create a regular expression object.
Set objRegExp = New RegExp

'Set the pattern by using the Pattern property.
objRegExp.Pattern = Pattern

' Set Case Insensitivity.
objRegExp.IgnoreCase = True

'Set global applicability.
objRegExp.Global = True

'Test whether the String can be compared.
If (objRegExp.Test(FormulaText) = True) Then

'Do the replacement
FormulaText = objRegExp.Replace(FormulaText, ReplWith)

Debug.Print FormulaText

End If

End Sub
================================

Hope this helps


--ron