Adapting code to return cell values rather than cell references

[ChristineJ]

I have been using the following code successfully to return any cell references in a formula that are "not allowed". Is there a way to adapt it so that it returns the values in the cell references that are "not allowed" rather than the cell references themselves?

Sub HelperCells(fCell As String, rCell As String)                 '
  Dim xRegEx As Object, xMatch As Object, d As Object
  Dim allowed As String, Sheetname As String, s As String
  
Dim addresses As String
Dim c As Integer
Dim r As Integer
Dim n As Integer
Dim addaray As Variant

allowed = "C9,E9,G9,C10,E10,G10,C11,E11,G11," & _
"C12,G12,C14,"

  Sheetname = ActiveSheet.Name & "!"
  Set d = CreateObject("Scripting.Dictionary")
  Set xRegEx = CreateObject("VBSCRIPT.REGEXP")
  With xRegEx
    .Pattern = "('?[a-zA-Z0-9\s\[\]\.]{1,99})?'?!?\$?[A-Z]{1,3}\$?[0-9]{1,7}(:\$?[A-Z]{1,3}\$?[0-9]{1,7})?"
    .Global = True
    For Each xMatch In .Execute(Replace(Replace(Replace(Replace(Range(fCell).Formula, ":", ","), "$", ""), " ", ""), Sheetname, ""))
      If InStr(1, "," & allowed & ",", "," & xMatch & ",") = 0 And Not d.Exists(CStr(xMatch)) Then
          s = s & ", " & xMatch
          d(CStr(xMatch)) = 1
      End If
    Next xMatch
  End With
  
  addresses = Mid(s, 3)
  
  If addresses = "" Then
    addresses = addresses
 
Else
addresses = "=SUM(" & Mid(s, 2) & ")"
End If
Range(rCell).Value = addresses
addaray = Split(addresses, ",")
End Sub

Original code provided by Peter_SSs at

Identifying cell references used in a formula

Cell F20 contains a formula such as =D7+D8+D9, =D7+D8+2100, or SUM(D7:D9). I want to test FORMULATEXT(F20), the actual formula in F20, to determine (TRUE or FALSE) if all cell references used are within the range D6:D14. For example, D7+D8+D9 would return TRUE. But D7+D8+K9 or D7+D8+D50 would...

www.mrexcel.com

(Thanks!)

 

[StephenCrump]

Try this:

Sub HelperCells(fCell As String, rCell As String)                 '
    
    Dim xRegEx As Object, xMatch As Object, d As Object
    Dim allowed As String, Sheetname As String, s As String, addaray() As String
    
    allowed = "C9,E9,G9,C10,E10,G10,C11,E11,G11,C12,G12,C14"
    Sheetname = ActiveSheet.Name & "!"
    Set d = CreateObject("Scripting.Dictionary")
    Set xRegEx = CreateObject("VBSCRIPT.REGEXP")
    
    On Error Resume Next
    Range("MyChecks").ClearContents
    On Error GoTo 0
    
    With xRegEx
        .Pattern = "('?[a-zA-Z0-9\s\[\]\.]{1,99})?'?!?\$?[A-Z]{1,3}\$?[0-9]{1,7}(:\$?[A-Z]{1,3}\$?[0-9]{1,7})?"
        .Global = True
        For Each xMatch In .Execute(Replace(Replace(Replace(Replace(Range(fCell).Formula, ":", ","), "$", ""), " ", ""), Sheetname, ""))
            If InStr(1, "," & allowed & ",", "," & xMatch & ",") = 0 And Not d.Exists(CStr(xMatch)) Then
                s = s & "," & xMatch
                d(CStr(xMatch)) = 1
            End If
        Next xMatch
    End With
      
    If Len(s) Then
        addaray = Split(Mid(s, 2), ",")
        With Range(rCell).Resize(, UBound(addaray) + 1)
            .Value = addaray
            .Name = "MyChecks"
            .Cells(2, 1).Formula2 = "=CELL(""Contents"",INDIRECT(MyChecks))"
        End With
    Else
        Range(rCell).Value = "Looks OK"
        Range(rCell).Offset(1).ClearContents
    End If

End Sub

 

[ChristineJ]

This does it! Thank you!