Search code examples
excelarray-formulasvba

excel vba value paste all formulas of type "=X()"


I have a database app that stores data in array formulas through a UDF.

I would like to have a macro that goes through the sheet/wbook and breaks all the external links by replacing the udf array formula with the current value in the given cell.

The challenge is that cells within a given array formula can't be written individually. For example a macro like that below will cause the entire array to be destroyed on the first write.

Public Sub breaklink()
Dim c
For Each c In ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas)
    Debug.Print c.FormulaArray
    If InStr(c.FormulaArray, "MYFORMULA(") Then
        Stop
        c.FormulaArray = c.Value
        'c.Value = c.Value     --THIS THROWS ERROR 1004 (Can't edit part of an array)
        Stop
    End If
Next
End Sub

If there were a cell method like c.getArrayFormulaRange, then I could use it to create an array of values and then write-over the array formula.

I could conceivably loop through adjacent cells to attempt to find the bounds of each array, but this seems quite cumbersome (also, I'd be changing the range I was looping through during the loop, which could raise problems). Is there any method or object property that will help me identify the entire range that is occupied by a given array formula?


Solution

  • Following simpLE MAn's suggestions above, this is my solution:

    Public Sub breakLinks(scope As String)
    Dim formula_tokens()
    Dim c As Range, fa_range As Range
    Dim ws As Worksheet
    Dim token
    formula_tokens = Array("MYFORMULA1(", "MYFORMULA2(", "OTHERFORMULA(", "OTHERFORMULA2(")
    If scope = "sheet" Then
        For Each c In ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas)
            For Each token In formula_tokens
                If InStr(UCase(c.FormulaArray), token) Then
                    If c.HasArray Then
                        Set fa_range = c.CurrentArray
                        fa_range.FormulaArray = fa_range.Value
                    Else
                        c.Formula = c.Value
                    End If
                End If
            Next
        Next
    
    ElseIf scope = "wbook" Then
        For Each ws In Worksheets
            For Each c In ws.Cells.SpecialCells(xlCellTypeFormulas)
                For Each token In formula_tokens
                    If InStr(UCase(c.FormulaArray), token) Then
                        If c.HasArray Then
                            Set fa_range = c.CurrentArray
                            fa_range.FormulaArray = fa_range.Value
                        Else
                            c.Formula = c.Value
                        End If
                    End If
                Next
            Next
        Next
    
    End If
    
    End Sub