VBA to copy formulas into worksheets - Application-defined error

[fbohlandt]

Hi all

I run a simple piece of code that copies formulas into cells of a worksheet. The formulas themselves reference the Cognos Controller link API and are embedded in a IFERROR statement, e.g.:

=IFERROR(@cc.fGetVal(J$9,,,J$8,J$6,J$3,J$6,J$2,$A28,,,,,,J$4,,J$5),)

The code runs fine for instance of Excel that are part of the Office 365 package. The client is running Excel 2012 and the code returns an 'Application-defined or Object-defined error'. I have asked the client to deactivate the Cognos add-in and run the code to prevent any interference. I still get the same error. This leads me to believe it may be related to a versioning issue.

The full code is shown below; fails at .Range(.Cells(fRow, fCol), .Cells(n, m)) = Arr1:

Option Base 1
Sub fGetValue_Cognos(wsName As String, CognosLink As Boolean)


'Dim CognosLink As Boolean '!***!
'CognosLink = True


'***
'* Purpose:         Replace Values with fGetValue function based on PoV fields
'* Last update:     15 November 2021
'* Author:          Florian Bohlandt
'***


Dim wb As Workbook
Dim wsFin As Worksheet
Dim rngPoV As Range, rngCol As Range, rngRow As Range, rngData As Range
Dim n As Integer, m As Integer, i As Integer, j As Integer
Dim fRow As Integer, fCol As Integer, RowNum As Integer, ColNum As Integer
Dim ColRef As String
Dim Arr1() As Variant, Arr2() As Variant, Arr3() As Variant


On Error GoTo ErrorTrap '!***!


Set wb = ThisWorkbook


'Set worksheets
With wb
    Set wsFin = .Sheets(wsName)
End With


'Find last row and column
n = LastCell(wsFin, True)
m = LastCell(wsFin, False)
fRow = 28 'first data row
fCol = 5 'first data col


'Define ranges (manual)
With wsFin
    Set rngPoV = .Range("A6:B6") '<-- Entity
    Set rngCol = .Range(.Cells(1, fCol), .Cells(1, m)) '<-- PoV (adjusts dynamically for added columns)
    Set rngRow = .Range(.Cells(fRow, 1), .Cells(n, 2)) '<-- Accounts (adjusts dynamically for added rows)
    Set rngData = .Range(.Cells(fRow, fCol), .Cells(n, m)) '<-- Data
End With
RowNum = rngData.Rows.Count
ColNum = rngData.Columns.Count
ReDim Arr1(RowNum, ColNum)
ReDim Arr2(RowNum, 1)
ReDim Arr3(1, 1)


cnt = 0
For i = 1 To RowNum
    For j = 1 To ColNum
        If rngRow(i, 1) = "" Or rngCol(1, j) = "" Then
            'Other formula types
            Arr1(i, j) = rngData(i, j).Formula
        Else
            If CognosLink = True Then
                ColRef = Col_Letter(fCol + j - 1)
                RowRef = fRow + i - 1
                'fGetValue function
                Arr1(i, j) = "=IFERROR(@cc.fGetVal(" & ColRef & "$9,,," & ColRef & _
                    "$8," & ColRef & "$6," & ColRef & "$3," & ColRef & "$6," & ColRef & _
                    "$2,$A" & RowRef & ",,,,,," & ColRef & "$4,," & ColRef & "$5),)"
                'fAccName function
                Arr2(i, 1) = "=IFERROR(@cc.fAccName(A" & RowRef & "),)"
                'fCompName function
                Arr3(1, 1) = "=IFERROR(@cc.fCompName(A6),)"
            Else
                ColRef = Col_Letter(fCol + j - 1)
                RowRef = fRow + i - 1
                'fGetValue --> PasteValue
                Arr1(i, j) = rngData(i, j).Value
                'fAccName --> PasteValue
                Arr2(i, 1) = rngRow(1, 2).Value
                'fCompName --> PasteValue
                Arr3(1, 1) = rngPoV(1, 2).Value
            End If
        End If
    Next
Next


'Copy data to target
With wsFin
    .Range(.Cells(fRow, fCol), .Cells(n, m)) = Arr1
    .Range(.Cells(fRow, 2), .Cells(n, 2)) = Arr2
    .Cells(6, 2) = Arr3
End With


Exit Sub '!***!
ErrorTrap: '!***!
MsgBox Err.Description '!***!


End Sub

 

[sijpie]

I can't immediately see an issue with the 'offending' line. But it may be that there is something wrong with the sizes of the ranges and the array.

But I am surprised at how inefficient your code is set up. unless the ranges you are dealing with are very small, your code is slowed down by a lot of cell reads; each cell of the various ranges is read and copied individually into the arrays. I would read the data into the arrays in one operation. Then do all the checking and modifications in the arrays. Then write back the modified arrays . this is much, much faster.

My code would look like this:

Option Explicit

Option Base 1


Sub fGetValue_Cognos(wsName As String, CognosLink As Boolean)


    'Dim CognosLink As Boolean '!***!
    'CognosLink = True
    
    
    '***
    '* Purpose:         Replace Values with fGetValue function based on PoV fields
    '* Last update:     15 November 2021
    '* Author:          Florian Bohlandt
    '***
    
    
    Dim wb As Workbook
    Dim wsFin As Worksheet
    Dim rngPoV As Range, rngCol As Range, rngRow As Range, rngData As Range
    Dim n As Integer, m As Integer, i As Integer, j As Integer
    Dim fRow As Integer, fCol As Integer, RowNum As Integer, ColNum As Integer
    Dim ColRef As String
    Dim arrData As Variant, arrRow As Variant, arrCol As Variant, varCompName As Variant
    
    
    On Error GoTo ErrorTrap '!***!
    
    
    Set wb = ThisWorkbook
    
    
    'Set worksheets
    With wb
        Set wsFin = .Sheets(wsName)
    End With
    
    
    'Find last row and column
    n = LastCell(wsFin, True)
    m = LastCell(wsFin, False)
    fRow = 28 'first data row
    fCol = 5 'first data col
    
    
    'Define ranges (manual)
    With wsFin
        Set rngPoV = .Range("A6:B6") '<-- Entity
        Set rngCol = .Range(.Cells(1, fCol), .Cells(1, m)) '<-- PoV (adjusts dynamically for added columns)
        Set rngRow = .Range(.Cells(fRow, 1), .Cells(n, 2)) '<-- Accounts (adjusts dynamically for added rows)
        Set rngData = .Range(.Cells(fRow, fCol), .Cells(n, m)) '<-- Data
    End With
    'Load the data into arrays for fast processing (one read only each)
    arrData = rngData.Formula
    arrRow = rngRow.Value
    arrCol = rngCol.Value
    
    RowNum = UBound(arrData, 1)
    ColNum = UBound(arrData, 2)
    
    'take the recording of the compname out of the loop. Else it gets done over and over again!
    If CognosLink Then
        'fCompName function
        varCompName(1, 1) = "=IFERROR(@cc.fCompName(A6),)"
    Else
        'fCompName --> PasteValue
        varCompName(1, 1) = rngPoV(1, 2).Value
    End If
    
    
    cnt = 0
    For i = 1 To RowNum
        For j = 1 To ColNum
            If arrRow(i, 1) = "" Or arrCol(1, j) = "" Then
                'Other formula types
                'do nothing. Correct formula stored
            Else
                If CognosLink = True Then
                    ColRef = Col_Letter(fCol + j - 1)
                    RowRef = fRow + i - 1
                    'fGetValue function
                    arrData(i, j) = "=IFERROR(@cc.fGetVal(" & ColRef & "$9,,," & ColRef & _
                        "$8," & ColRef & "$6," & ColRef & "$3," & ColRef & "$6," & ColRef & _
                        "$2,$A" & RowRef & ",,,,,," & ColRef & "$4,," & ColRef & "$5),)"
                    'fAccName function
                    arrRow(i, 1) = "=IFERROR(@cc.fAccName(A" & RowRef & "),)"
                Else
                    ColRef = Col_Letter(fCol + j - 1)
                    RowRef = fRow + i - 1
                    '<<<<< what are these two operations above doing? The variables aren't used.
                    'Do nothing. correct data already loaded in arrays
                End If
            End If
        Next
    Next
    
    
    'Copy data to target
    'You have already set range names to these ranges, so use these instead of recalculating the ranges
''    With wsFin
''        .Range(.Cells(fRow, fCol), .Cells(n, m)) = arrData
''        .Range(.Cells(fRow, 2), .Cells(n, 2)) = arrRow
''        .Cells(6, 2) = varCompName
''    End With
    
    rngData.Formula = arrData
    rngRow.Formula = arrRow
    wsFin.Cells(6, 2) = varCompName
    
    Exit Sub '!***!
ErrorTrap:     '!***!
    MsgBox Err.Description '!***!


End Sub

 

[fbohlandt]

Thank you for your reply.

I agree that the varCompName should not be in the loop, I added this is the wrong place.

Let me try and rephrase what I am trying to achieve with the rest of the code:

Purpose: to toggle between pasted values and Cognos Link function (Cognos Controller API), depending on whether the user has access to Controller

The conversion to pasted values is trivial so I am focussing on the inverse process of creating the controller functions:

1. Create Cognos Controller functions (signified by the at sign) on the fly with changing input from cell references
2. Load the controller functions to an Array
3. Copy array to spreadsheet

This works very well in Excel 365 but I believe that is coincidental. Excel now accepts the at sign character as part of a formula build but earlier versions of Excel do not.

This means the error not related to a mismatch between array and range. I confirmed this by pasting a 1 x 1 array into a single cell. Strangely, older Excel versions balk at arrays being pasted that include the at sign but copying/pasting cells contents is fine.

Worst case I can add a placeholder for the at sign an search and replace. I was hoping for a more elegant solution.