ChristineJ
Well-known Member
- Joined
- May 18, 2009
- Messages
- 771
- Office Version
- 365
- Platform
- Windows
This function extracts the cell references from a string and returns them in another cell.
Example: D10 contains =A4+B23+100-SUM(K12:L15)
G10 contains =ExtractCellRefs(D10) and that returns A4, B23, K12:L15
Is it possible to convert this to a macro, where every cell in column D with a value has its cell references (or "No Matches") returned on the same row in column G?
Example: D10 contains =A4+B23+100-SUM(K12:L15)
G10 contains =ExtractCellRefs(D10) and that returns A4, B23, K12:L15
Is it possible to convert this to a macro, where every cell in column D with a value has its cell references (or "No Matches") returned on the same row in column G?
Code:
Function ExtractCellRefs(Rg As Range) As String
Dim xRetList As Object
Dim xRegEx As Object
Dim I As Long
Dim xRet As String
Application.Volatile
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
Set xRetList = xRegEx.Execute(Rg.Formula)
If xRetList.Count > 0 Then
For I = 0 To xRetList.Count - 1
xRet = xRet & xRetList.Item(I) & ", "
Next
ExtractCellRefs = Left(xRet, Len(xRet) - 2)
Else
ExtractCellRefs = "No Matches"
End If
End Function