Extract cell references from a formula using VBA?

[Indystick]

First question, and I apologize if it has been asked before (I have searched the forums but did not find any posts that I recognized as a possible solution). If you're aware of another post that address this issue, please share the link!

Context: I teach a college course, and my exams are partially completed worksheets that the students have to write the formulas to complete (similar to the ModelOff applied problems if you're familiar with those). I have a "scorecard" in the file that compares the output of their formulas to the correct output and gives them points if they match.

My problem is, that for formulas that are dependent on prior inputs being calculated correctly, the scorecard marks the cell as wrong if the formulas is correct but the precedent values are wrong. I don't want this, because I am evaluating the formula, not the result (if that makes sense). It occurred to me, that I might be able to create a custom function that takes the formula as an input and modifies the cell references to ones containing the correct precedents, and then evaluating the formula for the value it returns. I have been able to make it work with formulas that have ranges. Here is a limited example:

Public Function FormulaTest(Cell As Range) As Boolean

    Dim CellFormula As Variant
    Dim D15Test As Double
    Dim Rng As Range
    D15Test = Worksheets("Comparison Worksheet").Range("D15").Value
    Debug.Print (Cell.Formula)
    
    If InStr(Cell.Formula, ":") <> 0 Then
        CellFormula = Replace(Cell.Formula, Cell.Address, "'Comparison Worksheet'!" & Cell.Address)
        Debug.Print (CellFormula)
        If Evaluate(CellFormula) = D15Test Then
            FormulaTest = True
        Else
            FormulaTest = False
        End If
    Else


        
    End If
    
    


End Function

What I need, is a method of extracting individual cell references when it's not a range involved (e.g., SUM(A1,B1,C1) instead of SUM(A1:C1)). Ideally, the extracted cell references would be stored in a string array (I sort of envision this as a tokenizer).

The one caveat, I do not know what the operators in the formula will be in advance, so I cannot use them as delimiters.

 

[frank_AL]

Let me suggest something and if you agree with this approach I can provide code to support the concept.

This approach uses, 2 Workbooks. Your Workbook (Professor) which has test answers and the Students Workbook.

The Professor Workbook would contain test answers and the VBA Code module.
For each question on the test, there would be 1 row in the Professor Workbook that contains details about the expected response.
For example: if the expected answer/formula is "=A1/B1" then in the Professor Workbook you would have

[TABLE="width: 384"]
<colgroup><col width="64" span="6" style="width:48pt"> </colgroup><tbody>[TR]
[TD="class: xl65, width: 64"]A [/TD]
[TD="class: xl65, width: 64"]B[/TD]
[TD="class: xl65, width: 64"]C[/TD]
[TD="class: xl65, width: 64"]D[/TD]
[TD="class: xl65, width: 64"]E[/TD]
[TD="class: xl65, width: 64"]F[/TD]
[/TR]
[TR]
[TD="class: xl65"]A1[/TD]
[TD="class: xl65"]2[/TD]
[TD="class: xl65"]/[/TD]
[TD="class: xl65"]4[/TD]
[TD="class: xl65"]B1[/TD]
[TD="class: xl65"]5
[/TD]
[/TR]
</tbody>[/TABLE]

So you could then Loop until next Column is blank using the Search function to see if the Formula contains the proper cells in the proper location within the Formula.

Simple code example
DIM result as String

result = ActiveCell.Formula (ActiveCell.Formula would be reading from the Students Workbook)
If(SEARCH(A1,result)=B1
If(SEARCH(C1,result)=D1
If(SEARCH(E1,result)=F1

Again, if you think this approach would work let me know and I can develop this portion of the code that you could integrate into the code you have already developed.

 

[Indystick]

Thank you for the suggestion. That is a really clever idea. The problem, I think, is that I may not capture all permutations that the students might submit ahead of time. The answers could take multiple forms. E.g., a student could put =A1*B1 + A2*B2 + A3*B3 or =SUMPRODUCT(A1:A3,B1:B3).

Basically, what I want to do is capture their formula, temporarily update the cell references to the answer worksheet (where I know I'm getting the right input values which are themselves calculated via formula) and then evaluating the answer and returning a TRUE / FALSE result. The idea being, I could call that function in a conditional format rule and/or separate logical formula.

 

[Indystick]

Sorry, forgot to include, that I have a solved worksheet in the workbook that I am using for comparison purposes (i.e., to see if their formula returns the correct value).

 

[frank_AL]

Here's an idea assuming you are using Excel 2011 or newer. There is a "Formula" function that returns the formula from a cell rather than the computed value. I tested it by putting the formula "=B1+C1" in cell A1. The variable strFormula contained the actual formula when presented to me with the MsgBox function. Using this approach you could obtain the student's formula, copy it into your spreadsheet and verify you get the expected result. Let me know if you are interested in using this approach and again I can build you a module.

Range("A1").Select
Dim strFormula As String
strFormula = ActiveCell.Formula
MsgBox (strFormula)

 

[Indystick]

Hi again. I very much appreciate you're willingness to help me out, and I apologize if I am wasting your time, but I think it's still not clear what I am trying to accomplish.

In my exam, there are two protected worksheets. In one, the students write formulas. In the second, the worksheet is completed. I have a "scorecard" that compares the outputs of the student's formulas to the outputs to the completed worksheet outputs, and if they're equal, gives them points (plus some conditional formatting to visually cue them):

You can see in the example above that there are 6 cells (B5, D15, D17 & D18) that are being evaluated, four are being evaluated as correct, two as incorrect (D16, D19).

Now here's the problem with this approach. The formula in cell D19 (the bottom incorrect cell in the scorecard) is actually the correct formula. However, the scorecard marks it wrong, because the formula in cell D19 has the value in cell D16 as a precedent, and D16 is incorrect. For example:

Assume the correct formula in D19 is SUM(D15:D18), and that is what the student has in D19. However in D16, they have an error in their formula and are returning the wrong value:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]D15[/TD]
[TD]D16[/TD]
[TD]D17[/TD]
[TD]D18[/TD]
[TD]D19[/TD]
[/TR]
[TR]
[TD]Student[/TD]
[TD]1[/TD]
[TD]3[/TD]
[TD]3[/TD]
[TD]4[/TD]
[TD]SUM(1,3,3,4) = 11[/TD]
[/TR]
[TR]
[TD]Correct[/TD]
[TD]1[/TD]
[TD]2[/TD]
[TD]3[/TD]
[TD]4[/TD]
[TD]SUM(1,2,3,4) = 10[/TD]
[/TR]
</tbody>[/TABLE]

Now, when I grade these, I look at the formula, and I'd give the student the points for D19 because the formula is the correct formula in the sense that, given the correct precedent values, it will return the correct result.

What I am trying to do is take the student's formula =SUM(D15:D18), convert it to =SUM('Comparison Worksheet'!D15:D18), and if upon evaluation, that formula returns the correct value, return TRUE from the function.

I was able to access the file I've been working in, trying to develop the code. Here is what I have so far:

Public Function FormulaTest(Cell As Range) As Boolean

    Dim CellFormula As Variant
    Dim D15Test As Double
    Dim Rng As Range
    D15Test = Worksheets("Comparison Worksheet").Range("D15").Value
    Debug.Print (Cell.Formula)
    
    If InStr(Cell.Formula, ":") <> 0 Then
        CellFormula = Replace(Cell.Formula, Cell.Address, "'Comparison Worksheet'!" & Cell.Address)
        
    Else
        For Each Rng In Cell.Precedents.cells
           CellFormula = Replace(CellFormula, Rng.Address, "'Comparison Worksheet'!" & Rng.Address(False, False))
        Next
        Debug.Print (CellFormula)

        
    End If

    If Evaluate(CellFormula) = D15Test Then
        FormulaTest = True
    Else
        FormulaTest = False
    End If

    
    


End Function

The first part of the the first IF/THEN test seems to work okay (though I have to test it out and make some modifications so I can account for testing in different cells).

Where I am running into difficulty, is the for loop. I can't seem to parse out the cell references from the formula and modify them.

 

[frank_AL]

I don't mind trying to help you!

I think we are thinking along the same lines with a bit of a twist. Where you are copying the formula from your Comparison Worksheet I'm thinking take the student's formula to the Comparison Worksheet.

To do this on your Comparison Worksheet (or a separate Worksheet) you would have 2 columns. Column 1 would be the cell reference where an answer should be input. Column 2 would be the correct answer.

It would be easy to step through this list to determine if the student's formula gives the correct answer. This would work regardless of the method the student uses to arrive at the correct answer unless you are expecting a specific approach.
If expecting a specific approach then you could add a third column that has the Function the student should use. We could use the SEARCH Function to ensure they used that Function in their formula.

For Example:

Cell Answer Function
D19 10 Sum
etc.
etc.

Feedback?

 

[Indystick]

Sorry for the delay in getting back to you. I've spent some more time on the problem and come up with part of the solution. If I can figure out the rest (perhaps with your help) I'll take it from a generic application in a test setting, and tailor it to my working worksheet.

Here is what I came up with:

Sub changeFormula()    Dim rngToCheck As Range 'Cell I want to check formulas on
    Dim rngPrecendents As Range 'Precedents of formula
    Dim rngPrecedent As Range 'Specific precedent in formula
    Dim myFormula As Variant 'Modified formula
    Dim cellRef As String  'For converting range to string type
    
    
    myFormula = Range("A4").Formula 'this is the cell whose formula I want to check
    
    Set rngToCheck = Range("A4")
    Set rngPrecedents = rngToCheck.Precedents
    


    
    For Each rngToCheck In Worksheets("Sheet1").Range("A4")
        If InStr(rngToCheck.Formula, ":") <> 0 Then 'If the formula contains a range, e.g., A1:A4 then we want to change A1 to Sheet2!A1
            myFormula = Replace(rngToCheck.Formula, "A1", "'Sheet2'!A1")
            Debug.Print myFormula
        
        Else
            'If the formula contains individual cell references, change each to Sheet2!
            For Each rngPrecedent In rngPrecedents
                cellRef = rngPrecedent.Address(False, False, External:=False)
                myFormula = Replace(myFormula, cellRef, "'Sheet2'!" & cellRef)
            Next rngPrecedent
        
        End If
    Next rngToCheck
    
    'Getting rid of = in formulas
    myFormula = Replace(myFormula, "=", "")
    Debug.Print myFormula
    
    'Evaluating Formula
    'Debug.Print Evaluate(myFormula)
    
    
End Sub

You can't use Range.Precedents in functions, only in subroutines. So what I've done is create a subroutine that takes the formula in cell A4 and then,

• If the formula contains a range, e.g.=SUM(A1:A4), then it will it will change the leading reference to 'Sheet2'!A1 and thus the formula to =SUM('Sheet2'!A1:A4)
• Otherwise, it will parse each individual cell reference and change to the Sheet2 reference (e.g. =A1+A2+A3 become ='Sheet2'!A2 + 'Sheet2'!A3 + 'Sheet2'!A4

I'm using the Debug.Print to confirm that the reference changes worked correctly.

You can confirm that it works correctly as well. Just put 1, 2, 3 in A1:A3 respectively then create a formula with a range, then with an operator. NOTE: I haven't tried this with more complex formulas with more than one range as an argument.

Okay, whew. So here's what I want to do with this:

• I want to be able to call this subroutine from a function (e.g., TestMyFormula) where the function passes a cell reference to the subroutine for evaluation
• The subroutine converts the formulas and then evaluates the result using Evaluate
• The Evaluate result is compared to the value in Sheet2!A4 and if they're equal, returns TRUE, otherwise FALSE to the function which returns TRUE or FALSE

Does that make any sense?

 

[Indystick]

I've made a couple of further changes since last night.

1. I have set it up to evaluate the two formulas and return a boolean (testStatus - which I've declared as global)
2. I have tested it on formulas with multiple range arguments and it works fine!

Here is the updated code:

Public testStatus As Boolean

Sub changeFormula()
    Dim rngToCheck As Range 'Cell I want to check formulas on
    Dim rngPrecendents As Range 'Precedents of formula
    Dim rngPrecedent As Range 'Specific precedent in formula
    Dim myFormula As Variant 'Modified formula
    Dim cellRef As String  'For converting range to string type
    Dim comparisonRef As String
    
    
    myFormula = Worksheets("Sheet1").Range("A4").Formula 'this is the cell whose formula I want to check
    
    Set rngToCheck = Worksheets("Sheet1").Range("A4")
    Set rngPrecedents = rngToCheck.Precedents
    


    
    For Each rngToCheck In Worksheets("Sheet1").Range("A4")
        If InStr(rngToCheck.Formula, ":") <> 0 Then 'If the formula contains a range, e.g., A1:A4 then we want to change A1 to Sheet2!A1
            myFormula = Replace(rngToCheck.Formula, "A1", "Sheet2!A1")
            Debug.Print myFormula
        
        Else
            'If the formula contains individual cell references, change each to Sheet2!
            For Each rngPrecedent In rngPrecedents
                cellRef = rngPrecedent.Address(False, False, External:=False)
                myFormula = Replace(myFormula, cellRef, "'Sheet2'!" & cellRef)
            Next rngPrecedent
        
        End If
    Next rngToCheck
    
    'Getting rid of = in formulas
    myFormula = Replace(myFormula, "=", "")
    Debug.Print myFormula
    
    'Evaluating Formula
    comparisonRef = Worksheets("Sheet2").Range("A4")
    comparisonRef = Replace(comparisonRef, "=", "")
    If Evaluate(myFormula) = Evaluate(comparisonRef) Then
          testStatus = True
        Debug.Print testStatus
    Else
        testStatus = False
        Debug.Print testStatus
    End If
    
    Debug.Print Evaluate(myFormula)


    'Formula should be =SUM(Sheet2!A1:A3)
    
    
End Sub

So now I just need to accomplish the following:

1. Modify the sub declaration to receive a range as an argument
2. A function to that takes a cell reference as an argument and passes it to the sub and returns whatever boolean the sub returns.

 

[frank_AL]

Here is a sub that calls changeformula and passes a range; 'studentrng' declared as a Public variable. It receives back the value of the boolean variable 'teststatus'.

Option Explicit
Public studentrng As Range
Sub passrange()
Set studentrng = Range("A4")
Call changeFormula(studentrng)
MsgBox testStatus

End Sub

I modified your code to accept the studentrng value.

Option Explicit

Public testStatus As Boolean

[COLOR=#ff0000]Sub changeFormula(studentrng As Range)[/COLOR]
    Dim rngToCheck As Range 'Cell I want to check formulas on
    Dim rngPrecedents As Range 'Precedents of formula
    Dim rngPrecedent As Range 'Specific precedent in formula
    Dim myFormula As Variant 'Modified formula
    Dim cellRef As String  'For converting range to string type
    Dim comparisonRef As String
      
    myFormula = Worksheets("Sheet1").Range("A4").Formula 'this is the cell whose formula I want to check
    
    Set rngToCheck = Worksheets("Sheet1").Range("A4")
    Set rngPrecedents = rngToCheck.Precedents

    For Each rngToCheck In Worksheets("Sheet1").Range("A4")
        If InStr(rngToCheck.Formula, ":") <> 0 Then 'If the formula contains a range, e.g., A1:A4 then we want to change A1 to Sheet2!A1
            myFormula = Replace(rngToCheck.Formula, "A1", "Sheet2!A1")
            Debug.Print myFormula
        
        Else
            'If the formula contains individual cell references, change each to Sheet2!
            For Each rngPrecedent In rngPrecedents
                cellRef = rngPrecedent.Address(False, False, External:=False)
                myFormula = Replace(myFormula, cellRef, "'Sheet2'!" & cellRef)
            Next rngPrecedent
        
        End If
    Next rngToCheck
    
    'Getting rid of = in formulas
    myFormula = Replace(myFormula, "=", "")
    Debug.Print myFormula
    
    'Evaluating Formula
    comparisonRef = Worksheets("Sheet2").Range("A4")
    comparisonRef = Replace(comparisonRef, "=", "")
    If Evaluate(myFormula) = Evaluate(comparisonRef) Then
          testStatus = True
        Debug.Print testStatus
    Else
        testStatus = False
        Debug.Print testStatus
    End If
    
    Debug.Print Evaluate(myFormula)
     'Formula should be =SUM(Sheet2!A1:A3)
    
End Sub