Search code examples
excelvbareturn-valuedynamic-arraysexcel-365

VBA function does not return dynamic array


I am using Excel365. Below function is intended to have SumProduct work with arrays that contain empty cells generated by a formula - when the result of the formula is "", SumProduct has problems with dealing with the empty cell / with the underlying formula.

Public Function RealDate(Zelle As Range) As Variant
' Returns the corresponding array of dates as long as the cell contains a valid date
' Returns 1.1.1900 for all the cells with invalid formats or dates

    Dim c As Range
    Dim b As Boolean, i As Integer, MinDate As Date
    Dim outputArray As Variant

    MinDate = "1.1.1900"                        ' This should be the value 0 in integers
    ReDim outputArray(1 To Zelle.Count)
    On Error GoTo Continue

    i = 0
    For Each c In Zelle.Cells
        i = i + 1
        outputArray(i) = MinDate
        b = IsDate(c.Value) And (year(c.Value) >= 1900) And (Day(c.Value) > 0)
        If b Then outputArray(i) = c.Value
    Continue:
        MsgBox outputArray(i)
        Next c
 
    RealDate = outputArray
    ' Unfortunately, this statement does not work - what is returned is a vector of mainly integer 0 or 01.01.1900

End Function

The trouble is the following:

Function returns empty dates

that is either 01.01.1900 or 00.01.1900, although in the message box all the dates for outputArray are given correctly, that is 01.01.90, 31.01.13, 14.01.14, 29.08.23. The size of the dynamic array is 4 (and that is correct).

It seems like RealDate does not take over the correct values from outputArray - why ???

I am expecting the function RealDate to return the values correctly stored in outputArray.

What did I try: The funny thing is that the results depend on the last line RealDate = OutputArray. For example, when I return RealDate = VSTACK(outputArray) the function returns 3x #Value, and in the 4th row 00.01.1990

enter image description here

The same for RealDate(1) = outputArray(1) In both cases, when calling the function, no MsgBox is shown any more


Solution

  • You have to create and return a two-dimensional array:

        MinDate = Cdate(1)      
        ReDim outputArray(1 To Zelle.Count, 1 To 1)
        On Error GoTo Continue
    
        i = 0
        For Each c In Zelle.Cells
            i = i + 1
            outputArray(i, 1) = MinDate
            b = IsDate(c.Value) And (Year(c.Value) >= 1900) And (Day(c.Value) > 0)
            If b Then outputArray(i, 1) = c.Value