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.

 

[StephenCrump]

Or perhaps:

B5: =SUM(B2:B4) in both worksheets.

With Worksheets("Teacher")
    If .Evaluate(Replace(Replace(Worksheets("Student").Range("B5").Formula, "'Student!'", ""), "Student!", "")) = .Range("B5").Value Then
        'Give them a mark
    End If
End With

Book1
	A	B
1
2	Answer 1	1
3	Answer 2	2
4	Answer 3	4
5	Answer 4	7
Student

Book1
	A	B
1
2	Answer 1	1
3	Answer 2	2
4	Answer 3	3
5	Answer 4	6
Teacher

 

[frank_AL]

So I have made additional modifications to the initial code module and then to your code module to take full advantage of what I developed. Give it a try.

Option Explicit
Public evalcell As String
Sub passrange()


evalcell = "A4"
Call changeFormula(evalcell)
MsgBox testStatus


End Sub

Your modified code module

Option Explicit


Public testStatus As Boolean


Sub changeFormula(evalcell As String)
    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 strcomparisonRef As String
    
    Set studentrng = Worksheets("Sheet1").Range(evalcell)
    Set comparisonRef = Worksheets("Sheet2").Range(evalcell)
    
    myFormula = studentrng.Formula 'this is the cell whose formula I want to check
    
    Set rngToCheck = studentrng
    Set rngPrecedents = rngToCheck.Precedents
    
    For Each rngToCheck In Range(evalcell)
        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
    strcomparisonRef = comparisonRef.Formula
    strcomparisonRef = Replace(strcomparisonRef, "=", "")
    If Evaluate(myFormula) = Evaluate(strcomparisonRef) 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