Fast processing for cell-by-cell computation - Fix an issue.

[wwj]

It works even if a single cell (value).

Code: Select all

Sub convert_elapsed_time_to_date()
    '   Fast processsing!
    '
    '   Day 1 = January 1, 1913.
    '
    Dim wsIn As Worksheet
    Dim wsOut As Worksheet
    Dim data As Variant
    Dim result As Variant
    Dim dval As Double
    
    ThisWorkbook.Activate
    
    inSht = "ObsOnlyRenamed"
    outSht = "ObsDate"

    ' To speed up the macro.
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlManual
    
    ' Define the source and destination sheets
    Set wsIn = ThisWorkbook.Sheets(inSht)
    Set wsOut = ThisWorkbook.Sheets(outSht)
    
    ' Clear the destination sheet before copying
    wsOut.Cells.Clear
    
    ' Copy the contents from Sheet A to Sheet B
    wsIn.Cells.Copy Destination:=wsOut.Cells
    
    ' Convert the elapsed time to date.
    ' Number of columns in the formed-data sheet
    maxCol = wsOut.Cells(2, Columns.Count).End(xlToLeft).Column
    StartDate = DateValue("1/1/1913")
    
    For j = 1 To maxCol Step 2
    
        lastRow = wsOut.Cells(Rows.Count, j).End(xlUp).Row

        If lastRow >= 3 Then
            ' Assuming headers in rows 1-2, so the rows are excluded.
            Set DataRange = wsOut.Range(wsOut.Cells(3, j), wsOut.Cells(lastRow, j))
            
            If DataRange.Rows.Count = 1 Then    ' If it has a single value, it becomes a scalar, not an array.
                ReDim result(1 To 1, 1 To 1)    ' Make it a 2D array.
                result(1, 1) = DataRange.Value
            Else
                ' Resize the result array
                data = DataRange.Value           ' It is a 2D array.
                ReDim result(1 To UBound(data, 1), 1 To 1)
                
                For i = 1 To UBound(data, 1)
                    result(i, 1) = data(i, 1) + StartDate ' Subtract
                Next i
            End If
            
            ' Write the result to the output column in one operation
            wsOut.Range(wsOut.Cells(3, j), wsOut.Cells(lastRow, j)).Value = result
            
            ' Set the formats.
            wsOut.Range(wsOut.Cells(3, j), wsOut.Cells(lastRow, j)).NumberFormat = "mm/dd/yyyy"
            wsOut.Range(wsOut.Cells(3, j + 1), wsOut.Cells(lastRow, j + 1)).NumberFormat = "0.00"
        End If
        
    Next j
    
    ' Activate the auto update!
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlAutomatic
    
    ' Message box
    MsgBox "Done for converting the elapsed times to dates! "
    
End Sub

[wwj]

[ Reason of the Error when lastRow = 3 ]

If lastRow = 3, then you're selecting a single cell (e.g., Range("A3")), not a multi-cell range. In VBA, when you assign the .Value of a single cell to a variable, it becomes a scalar (e.g., a string or number), not a 2D array. Then, when you later try to do this:

Code: Select all

ReDim result(1 To UBound(data, 1), 1 To 1)

You get a Type Mismatch or Subscript out of range error, because UBound(data, 1) assumes data is a 2D array, but it's not — it's just a scalar value.