Reputation: 9874
I want to create a user defined function that will solve a string equation in a designated cell after replacing the variable in the string with values.
The information is always in two columns. The top of the first column will contain a formula stored as a string. The bottom of the first column will contain the UDF. Between the formula and the UDF will be all the variables from the string formula. The second column will contain all the numeric values for the variables.
I do not know how to select to top of the column of information or the variables above the UDF in an automatic method since I do not know how to define the location of the cell the UDF is placed in.
Reference the location of the cell the UDF is in so that the location of the formula cell and the range for the variable cells can be defined. I am trying to write the UDF in a fashion that I do not have to pass it the address of the formula cell or the variables. I want it to grab that information on its own based on all the information being immediately adjacent to the cell with the UDF with no gaps.
Option Explicit
Public Function SolvedEquation() As Long
Dim FormulaCell As Range
Dim Equation As String
Dim VariableRange As Range
Dim VariableCell As Range
Dim VariablesLength As Integer
Dim Variable As String
Dim VariableValue As Double
'define FormulaCell as the last nonblank up from the cell the function is called in from a contiguous range(no spaces)
FormulaCell = Application.ThisCell.End(xlUp).Select
'define the VariableRange as one up from the cell the function is called to second last cell non blank cell located upward in a contiguous selection (no spaces)
VariableRange = Range(Cells(Application.ThisCell.Row - 1, Application.ThisCell.Column), Cells(FormulaCell.Row + 1, FormulaCell.Column))
Equation = FormulaCell.Value
For Each VariableCell In VariableRange.Cells
VariablesLength = Len(VariableCell.Value)-1
Variable = Left(VariableCell.Value, VariablesLength)
VariableValue = Cells(VariableCell.Row, VariableCell.Column + 1).Value
Equation = Replace(FormulaCell.Value, Variable, VariableValue)
Next VariableCell
SolvedEquation = Evaluate(Equation)
End Function
Suggestions for better coding appreciated (ie choice of range over cells)
With some code corrections from the individuals below I wound up with this so far. Where the 177.00 in the cell shows up, it should be reading 176.86. CORRECTION: got this last problem fixed by redefining the variable type as Chris did in his feedback.
Upvotes: 1
Views: 3504
Reputation: 53135
There are a number of issues in your code not directly related to ThisCell
See inline comments
Public Function SolvedEquation() As Variant '~~> allow for Error result
Dim FormulaCell As Range
Dim Equation As String
Dim VariableRange As Range
Dim VariableCell As Range
Dim VariablesLength As Integer
Dim Variable As String
Dim VariableValue As Double
'define FormulaCell as the last nonblank up from the cell the function is called in from a contiguous range(no spaces)
'~~> You must use Set and not use .Select
'~~> but this wont give you what you want if the cell above ThisCell is blank
'Set FormulaCell = Application.ThisCell.End(xlUp)
'~~> use this instead
If Application.ThisCell.Row <= 2 Then
' Function is in row 1 or 2. What now?
SolvedEquation = CVErr(xlErrNA)
Exit Function
Else
If IsEmpty(Application.ThisCell.Offset(-1, 0)) Then
Set FormulaCell = Application.ThisCell
Else
Set FormulaCell = Application.ThisCell.End(xlUp)
End If
End If
'define the VariableRange as one up from the cell the function is called to second last cell non blank cell located upward in a contiguous selection (no spaces)
'~~> use Set
'~~> define worksheet
'~~> simplify
'VariableRange = Range(Cells(Application.ThisCell.Row - 1, Application.ThisCell.Column), Cells(FormulaCell.Row + 1, FormulaCell.Column))
With Application.ThisCell
Set VariableRange = Range(.Offset(-1, 0), FormulaCell.Offset(1, 0))
End With
Equation = FormulaCell.Value
For Each VariableCell In VariableRange.Cells
VariablesLength = Len(VariableCell.Value) '- 1
Variable = Left$(VariableCell.Value, VariablesLength) '~~> string version of Left is faster
VariableValue = VariableCell.Offset(0, 1).Value '~~> simplify
Equation = Replace$(Equation, Variable, VariableValue) '~~> string version of Replace is faster, continue to work on Equation
Next VariableCell
SolvedEquation = Evaluate(Equation)
End Function
That said, your method has the inherent problem that it won't automatically recalculate when its input data changes because there is no reference to the source data in the function call. A better method is to pass a Range
parameter to the UDF referencing the equation and the source data, like this
Public Function SolvedEquation2(rng As Range) As Variant
Dim dat As Variant
Dim Equation As Variant
Dim i As Long
' copy range data to an array
dat = rng.Value
' Verify size of range
If UBound(dat, 1) < 2 Or UBound(dat, 2) < 2 Then
SolvedEquation2 = CVErr(xlErrNA)
Exit Function
End If
' Solve equation
Equation = dat(1, 1)
For i = 2 To UBound(dat, 1)
Equation = Replace$(Equation, dat(i, 1), dat(i, 2))
Next
' Use Worksheet version of Evaluate
SolvedEquation2 = rng.Worksheet.Evaluate(Equation)
End Function
Note: I don't see why you need to manipulate the variables as you do, so I've left that out. If this is needed update your Q with some sample data and expected Equation string and I'll update the A
Based on your sample, formula would be SolvedEquation2(O129:P133)
Note: Its better to use the Worksheet version of Evaluate. See this link from Charles Williams' website for reason why
Upvotes: 2