How to get cells from a string?

Question

I'm trying to create a function that gets a formula string from a cell as a parameter and returns all the cells it contains as a string array.

Function GetCells(str As String) As String
    Dim stringArray() As String

    GetCells = stringArray
End Function

I want to use this in a recursive function that goes throught all of the linked cells in a cell and replace the cell names with some string. This is a piece of concept code:

Dim result As String
Dim cell As Range
Dim stringArray() As String
Dim arraySize As Integer

Set stringArray = GetCells("A1 + A2")
arraySize = UBound(stringArray)

For n = 0 To arraySize Step 1
   Set cell = Range(stringArray(n))
   result = Replace(result, stringArray(n), "Some text")
Next

My only solution for this is to create a state machine and look for character and integer pairs then build the array from the results. Is there an easier way to do this throught some functions? If yes how?

Answer 1

After failed in trying to make work the solutions you posted in the answers I created my own one.
As I thought creating a state machine will solve the problem and it works perfectly for 1x1 cells, and this is all I wanted:

Source code

Function isChar(char As String) As Boolean
    Select Case char
        Case "A" To "Z"
            isChar = True
        Case Else
            isChar = False
    End Select
End Function

Function isNumber(char As String, isZero As Boolean) As Boolean
    Select Case char
        Case "0"
            If isZero = True Then
                isNumber = True
            Else
                isNumber = False
            End If
        Case "1" To "9"
            isNumber = True
        Case Else
            isNumber = False
    End Select
End Function

Function GetCells(str As String) As String
    Dim stringArray() As String
    Dim stringSize As Integer 'size of stringArray
    Dim c As Integer 'character number
    Dim chr As String 'current character
    Dim tempcell As String 'suspected cell's temporaly result
    Dim state As Integer 'state machine's state:
    '0 - nothing
    '1 - 1 character eg. A from A1
    '2 - 2 character eg. AG from AG156
    '3 - 3 character eg. AGH from AGH516516
    '4 - characters with number(s) eg. AH15 from AH1569
    '5 - first dollar sing eg. $ from $A$1
    '6 - second sollar sing eg. $A$ from $A$1

    Dim testresult As String

    state = 0
    stringSize = 0

    For c = 0 To Len(str) Step 1
        chr = Mid(str, c + 1, 1)
        Select Case state
            Case 0
                If isChar(chr) Then
                    state = 1
                    tempcell = tempcell & chr
                ElseIf chr = "$" Then
                    state = 5
                    tempcell = tempcell & chr
                Else
                    state = 0
                    tempcell = ""
                End If
            Case 1
                If isNumber(chr, False) Then
                    state = 4
                    tempcell = tempcell & chr
                ElseIf isChar(chr) Then
                    state = 2
                    tempcell = tempcell & chr
                ElseIf chr = "$" Then
                    state = 6
                    tempcell = tempcell & chr
                Else
                    state = 0
                    tempcell = ""
                End If
            Case 2
                If isNumber(chr, False) Then
                    state = 4
                    tempcell = tempcell + chr
                ElseIf isChar(chr) Then
                    state = 3
                    tempcell = tempcell + chr
                ElseIf chr = "$" Then
                    state = 6
                    tempcell = tempcell + chr
                Else
                    state = 0
                    tempcell = ""
                End If
            Case 3
                If isNumber(chr, False) Then
                    state = 4
                    tempcell = tempcell + chr
                ElseIf chr = "$" Then
                    state = 6
                    tempcell = tempcell + chr
                Else
                    state = 0
                    tempcell = ""
                End If
            Case 4
                If isNumber(chr, True) Then
                    state = 4
                    tempcell = tempcell + chr
                Else
                    state = 0
                    stringSize = stringSize + 1
                    ReDim Preserve stringArray(stringSize)
                    stringArray(stringSize - 1) = tempcell
                    tempcell = ""
                End If
            Case 5
                If isChar(chr) Then
                    state = 1
                    tempcell = tempcell + chr
                Else
                    state = 0
                    tempcell = ""
                End If
            Case 6
                If isNumber(chr, False) Then
                    state = 4
                    tempcell = tempcell + chr
                Else
                    state = 0
                    tempcell = ""
                End If
            Case Else
                state = 0
                tempcell = ""
        End Select
    Next c
    'GetCells = stringArray
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'This part is only for easily print the string array
    For c = 0 To stringSize Step 1
        testresult = testresult + " | " + stringArray(c)
    Next
    GetCells = testresult
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Function

Sub Main()
Dim s As String
s = "A1+B1+$A1-$B$65"
MsgBox (GetCells(s))

s = "(A5*2+HJ$15)-((F5+F1)-$F11+$PP$659)"
MsgBox (GetCells(s))

'also some crazy input
s = "A$61+$HK2+'p0thecakeisalie/0p'+DDD5+D1-$B$12-LCK$5065"
MsgBox (GetCells(s))

End Sub

Test

I created some test so you can see it in action. First two are simulating an everyday use while the third one is some crazy input, but the algorithm is still works for it.

Case 1

• Input: A1+B1+$A1-$B$65
• Output: | A1 | B1 | $A1 | $B$65 |

Case 2

• Input: (A5*2+HJ$15)-((F5+F1)-$F11+$PP$659)
• Output: | A5 | HJ$15 | F5 | F1 | $F11 | $PP$659 |

Case 3

• Input: A$61+$HK2+'p0thecakeisalie/0p'+DDD5+D1-$B$12-LCK$5065
• Output: | A$61 | $HK2 | DDD5 | D1 | $B$12 | LCK$5065 |

Answer 2

Another alternative is the regular expression matching capability available through the "Microsoft VBScript Regular Expressions 5.5" library.

The following regular expression-based function takes a string formula as argument and returns an array of the cell references in the formula. If no valid cell reference is found, it returns -1.

  Function GetCellRefs(formulaStr As String) As Variant

      Dim regEx As New VBScript_RegExp_55.RegExp
      Dim matches As Variant, match As Variant
      Dim resArr()
      Dim i As Long

      regEx.pattern = "(\$?[a-z]+\$?\d+\:\$?[a-z]+\$?\d+|\$?[a-z]+\$?\d+)"
      regEx.IgnoreCase = True
      regEx.Global = True

      If regEx.Test(formulaStr) Then
          Set matches = regEx.Execute(formulaStr)
          ReDim resArr(0 To matches.Count - 1)
          i = 0
          For Each match In matches
              resArr(i) = match.Value
              i = i + 1
          Next match
          GetCellRefs = resArr
      Else
          GetCellRefs = Array(-1)
      End If

  End Function

In order to use this function, you would need to add a reference to the library by choosing Tool/References from the VBA Editor and check-marking its title in the list of available references.

Answer 3

I think what you are looking for is this:

Range("A1").Precedents.Address

(Range.Precedents Property)

So, if A1 had the formula:

=B1+C2-D3

Then Range("A1").Precedents.Address would return:

$B$1,$C$2,$D$3

If the formula was:

=INDEX($D$1:$D$17,1,1)

Then $D$1:$D$17 is returned.

How can you use this? Just pass the Range object to a function of the range you want to evaluate, then take the returned list of addresses, throw that into another range object and evaluate each cell.

Here's an example (say cells A1 and A2 had formulas in them):

Option Explicit

Public Function getCells(ByRef r As Excel.Range) As String
    Dim s As String

    getCells = r.Precedents.Address
End Function

Public Sub test()
    Dim rangeString As String
    Dim r As Excel.Range
    Dim cell As Excel.Range

    rangeString = getCells(Sheet1.Range("A1:A2"))
    Set r = Range(rangeString)

    For Each cell In r
        ' do stuff
        Debug.Print "hello: " & cell.Address(0, 0)
    Next cell
End Sub