Forward Ed
Forward Ed

Reputation: 9874

how to reference the cell the function is called from

Situation

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.

Problem

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.

Objective

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.

What I Have

 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)

Example of data

enter image description here

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

Answers (1)

chris neilsen
chris neilsen

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

Related Questions