Streamlining VBA code to remove two cell references

ChristineJ

Well-known Member
Joined
May 18, 2009
Messages
686
Office Version
  1. 365
Platform
  1. Windows
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!

Code:
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
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
56,587
Office Version
  1. 365
Platform
  1. Windows
I would highly recommend forcing yourself to always declare all variables. You can do that in the vba window with this once-only setting

1648346077141.png


Failing to do so can easily lead to incorrect code results with no warning.


See if this does what you want.

VBA Code:
Sub NotAllowed()
  Dim xRegEx As Object, xMatch As Object, d As Object
  Dim allowed As String, Sheetname As String, s As String
  
  allowed = "D6,D7,D8,D9,D10,D11,D12,D13,D14" ' Allowable range
  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(Range("F19").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
  Range("W31").Value = Mid(s, 3)
End Sub
 
Last edited:
Solution

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
3,823
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Slight assist to @Peter_SSs ...

VBA Code:
Sub NotAllowed()
    Dim xRegEx As Object, xMatch As Object, d As Object
    Dim allowed As String, Sheetname As String, s As String
  
    allowed = "D6,D7,D8,D9,D10,D11,D12,D13,D14" ' Allowable range
    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(Range("F19").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
'
'   Assist
    s = Right$(s, Len(s) - 2)
    Range("W31") = s
End Sub
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
56,587
Office Version
  1. 365
Platform
  1. Windows
Slight assist to @Peter_SSs ...
Thanks for highlighting that I didn't quite copy all my code. However, your 'assist' will error in some circumstances.
I have edited my previous code to include all of it this time.
 

ChristineJ

Well-known Member
Joined
May 18, 2009
Messages
686
Office Version
  1. 365
Platform
  1. Windows
I would highly recommend forcing yourself to always declare all variables. You can do that in the vba window with this once-only setting

View attachment 60989

Failing to do so can easily lead to incorrect code results with no warning.


See if this does what you want.

VBA Code:
Sub NotAllowed()
  Dim xRegEx As Object, xMatch As Object, d As Object
  Dim allowed As String, Sheetname As String, s As String
 
  allowed = "D6,D7,D8,D9,D10,D11,D12,D13,D14" ' Allowable range
  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(Range("F19").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
  Range("W31")
Thank you so much - yes, this is what I needed. And I'll take your advice on declaring variables - still in the learning process. Appreciate the help, C
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
56,587
Office Version
  1. 365
Platform
  1. Windows
Thank you so much - yes, this is what I needed.
You're welcome.
Just check that you picked up my code edit only a few minutes ago. I had originally cut off the End Sub line and half the prvious line of code.
 

Forum statistics

Threads
1,176,255
Messages
5,902,171
Members
434,945
Latest member
ngabrieln

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top