Streamlining VBA code to remove two cell references

[ChristineJ]

I was provided the code below by a member on this forum a while back. I tweaked it a bit and have been using it successfully.

1. It looks at the formula in cell F19 and first removes any dollar signs and active worksheet names and returns that result in cell P31.
2. It then looks at the string in cell P31 and returns just the cell references in cell R31.
3. It then compares the cell references in R31 to those that are allowed and returns any cell references that not allowed in cell W31.

I'd like to accomplish this using variables for "Range("P31").Value and Range("R31").Value -- rather than having to have any values actually appear in those cells on the worksheet.

The formula in cell F19 is =SUM(D7+D8,E9)+CapCost!A1+$A$1
The code currently returns '=SUM(D7+D8,E9)+A1+A1 in cell P31
The code currently returns D7, D8, E9, A1, A1 in cell R31
The final result in cell W31 is E9, A1

The rest of it runs fine, as needed. I'd just like to see if it can be done without actually having anything entered in cell P31 or R31, using variables instead. Thanks!

Sub HelperCells()
    Dim xRetList As Object
    Dim xRegEx As Object
    Dim i As Long
    Dim xRet As String
    Dim allowedRange As Range
    Dim myRange As Range
    Dim T31 As String

   Application.ScreenUpdating = False
   Sheetname = ActiveSheet.Name & "!"

Range("P31").Value = "'" & Replace(Replace(Range("F19").Formula, "$", ""), Sheetname, "")
   
allowed = "D6,D7,D8,D9,D10,D11,D12,D13,D14" ' Allowable range
   
    'EXTRACT CELL REFERENCES FROM FORMULAS
    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
        .MultiLine = True
        .IgnoreCase = False
    End With
       For Each rg In Range("P31")
   
    Set xRetList = xRegEx.Execute(rg.Formula)
    If xRetList.Count > 0 Then
        For i = 0 To xRetList.Count - 1
            xRet = xRet & xRetList.Item(i) & ", "
        Next
        rg.Offset(0, 2) = Left(xRet, Len(xRet) - 2)
    Else
        rg.Offset(0, 2) = ""
    End If
    xRet = ""
    Next rg

T31 = RemoveDupeWords(GetUnique(allowed & "", Range("R31").Value & ""), ", ")

Range("W31").Value = T31
  
   Application.ScreenUpdating = True
End Sub

 

[ChristineJ]

Glad it worked for you. Thanks for your other comments too.

I'm not sure if it is important to you (or what could be done if it is) but suppose only D12, D13 and D14 were allowed and the formula was =SUM(D14:D17)
The above code will only report D17 as not allowed. It will not report D15 and D16 even though they are both included in the formula but not allowed.

Good point. But for my needs on this one, catching just the D17 outside of the allowable cells will be sufficient.

Thanks again!