Fast processing for cell by cell calculations (numbers to date)

Post Reply
wwj
Posts: 2497
Joined: 27 Jan 2007 08:16

Fast processing for cell by cell calculations (numbers to date)

Post by wwj »

Fast processing for cell by cell calculations
- Subtract the SS-period time
- Convert Elapsed Times to Date

= Subtract the SS-period time

Code: Select all


Sub convert_elapsed_time(flag As String)
    '
    ' Subtract the ss time (127750.0 days for SS, sp=1-5)
    ' - Speed up the calculation.
    '
    Dim ws As Worksheet
    Dim data As Variant
    Dim result As Variant
    
    ThisWorkbook.Activate
    
    dataSht = "FormedData"
    Set ws = ThisWorkbook.Sheets("FormedData")
    
    ' Speed up execution
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    ' Number of columns in the formed-data sheet
    maxCol = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column
    tm4ss = 127750#
    
    For j = 1 To maxCol Step 2
    
        lastRow = ws.Cells(ws.Rows.Count, j).End(xlUp).Row
        
        ' Load data into an array (columns A and B)
        data = ws.Range(ws.Cells(3, j), ws.Cells(lastRow, j)).Value  ' Assuming headers in row 1
        
        ' Resize the result array
        ReDim result(1 To UBound(data, 1), 1 To 1)
        
        For i = 1 To UBound(data, 1)
            result(i, 1) = data(i, 1) - tm4ss ' Subtract
        Next i
        
        ' Write result to column C in one operation
        ws.Range(ws.Cells(3, j), ws.Cells(lastRow, j)).Value = result
        
    Next j
    
    ' Restore settings
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
End Sub


Convert Elapsed Times to Date

Code: Select all


Sub convert_elapsed_time_to_date(flag As String)
    '   Fast processsing!
    '
    '   Day 1 = April 9, 1996.
    '
    Dim wsIn As Worksheet
    Dim wsOut As Worksheet
    Dim data As Variant
    Dim result As Variant
    Dim dval As Double
    
    ThisWorkbook.Activate
    
    inSht = "FormedData"
    outSht = "HwDate"

    ' 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
    dval = DateValue("4/9/1996")
    
    For j = 1 To maxCol Step 2
    
        lastRow = wsOut.Cells(Rows.Count, j).End(xlUp).Row
        
        ' data for the SS-period.
        wsOut.Range(wsOut.Cells(3, j), wsOut.Cells(6, j)) = ""
        wsOut.Range(wsOut.Cells(3, j), wsOut.Cells(6, j + 1)) = ""
        
        ' Load data into an array (columns A and B)
        data = wsOut.Range(wsOut.Cells(7, j), wsOut.Cells(lastRow, j)).Value  ' Assuming headers in row 1
        
        ' Resize the result array
        ReDim result(1 To UBound(data, 1), 1 To 1)
        
        For i = 1 To UBound(data, 1)
            result(i, 1) = data(i, 1) + dval ' Subtract
        Next i
        
        ' Write result to column C in one operation
        wsOut.Range(wsOut.Cells(7, j), wsOut.Cells(lastRow, j)).Value = result
        
        ' Set the formats.
        wsOut.Range(wsOut.Cells(3, j), wsOut.Cells(lastRow, j)).NumberFormat = "dd/mm/yyyy"
        wsOut.Range(wsOut.Cells(3, j + 1), wsOut.Cells(lastRow, j + 1)).NumberFormat = "0.00"
        
    Next j
    
    ' Activate the auto update!
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlAutomatic
    
    ' Message box
    MsgBox "Done for converting elapsed times to date! "
    
End Sub


Post Reply