excel vba date format into short date

[bobbyexcel]

Can someone help me on this please.. I'm try to run the following script however it is getting failed at line (lo.ListColumns("Final Status").DataBodyRange.Value = Result 'write array to listobject)

The reason is becoz of Date format. It works perfectly when I change the column date format(custom at this moment) into shortdate. but it is not working through vbscript. Please help me on this. This is the line I change the date to shortdate but no use.
RANGE("P" & Cell.Row).Value = FormatDateTime(RANGE("P" & Cell.Row).Value, vbShortDate)

    Sheets("temp_sheet").Activate

    Dim ws As Worksheet, DateRng As RANGE, Cell As RANGE, Lastrow As Integer
    Set ws = Worksheets("temp_sheet")
    
    Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    Set DateRng = RANGE("A2:A" & Lastrow)
    
    If Lastrow > 1 Then
            RANGE("D2:D" & Lastrow).TextToColumns Destination:=RANGE("K2"), DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 9), Array(3, 1), Array(7, 1), Array(10, 1), Array(19, 1), Array(23, 1)), TrailingMinusNumbers:=True
            RANGE("E2:E" & Lastrow).TextToColumns Destination:=RANGE("S2"), DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 9), Array(3, 1), Array(7, 1), Array(10, 1), Array(19, 1), Array(23, 1)), TrailingMinusNumbers:=True
        For Each Cell In DateRng
            RANGE("P" & Cell.Row).Value = RANGE("L" & Cell.Row).Value & "/" & RANGE("K" & Cell.Row).Value & "/" & RANGE("O" & Cell.Row).Value
            RANGE("P" & Cell.Row).Value = FormatDateTime(RANGE("P" & Cell.Row).Value, vbShortDate)
            RANGE("Q" & Cell.Row).Value = Application.WorksheetFunction.Text(ws.RANGE("P" & Cell.Row), "mm-dd-yyyy") & " " & Application.WorksheetFunction.Text(ws.RANGE("M" & Cell.Row), "hh:mm:ss")
            RANGE("R" & Cell.Row).Value = TimeValue(RANGE("Q" & Cell.Row))
            RANGE("X" & Cell.Row).Value = RANGE("T" & Cell.Row).Value & "/" & RANGE("S" & Cell.Row).Value & "/" & RANGE("W" & Cell.Row).Value
            RANGE("X" & Cell.Row).Value = FormatDateTime(RANGE("X" & Cell.Row).Value, vbShortDate)
            RANGE("Y" & Cell.Row).Value = Application.WorksheetFunction.Text(ws.RANGE("X" & Cell.Row), "mm-dd-yyyy") & " " & Application.WorksheetFunction.Text(ws.RANGE("U" & Cell.Row), "hh:mm:ss")
            RANGE("Z" & Cell.Row).Value = TimeValue(RANGE("Y" & Cell.Row))
        Next Cell
    RANGE("K:O,S:W").Delete
    RANGE("L:L").Cut
    RANGE("N:N").Insert Shift:=xlToRight
    RANGE("O:O").Cut
    RANGE("Q:Q").Insert Shift:=xlToRight
    RANGE("K1").Value = "Start_Date_Converted_Format"
    RANGE("L1").Value = "Start_Time_Converted_Format"
    RANGE("M1").Value = "Start_Date_N_Time"
    RANGE("N1").Value = "End_Date_Converted_Format"
    RANGE("O1").Value = "End_Time_Converted_Format"
    RANGE("P1").Value = "End_Date_N_Time"
    RANGE("Q1").Value = "Final Status"
    RANGE("R1").Value = "Time Conversion"
    RANGE("S1").Value = "Rank"
    
    Dim NumFormat As Integer

    RANGE("R:R").NumberFormat = Number
    RANGE("R:R").NumberFormat = "0.0000"
    
    For NumFormat = 2 To Lastrow
        Cells(NumFormat, 18).Value = TimeValue(Cells(NumFormat, 16).Value)
    Next NumFormat

    End If


Dim ListObj As ListObject
Dim sTable As String

sTable = "DataTable"

   Set ListObj = ActiveSheet.ListObjects.Add(xlSrcRange, [A1].CurrentRegion, , xlYes)
   ListObj.Name = "TBL_Jobs_temp" 'The name for the table

   ' Dim format() As Double
    'Dim dict(mykey) As String

     Dim T_Start, T_Stop, Shift_Start, Shift_Stop, Result    'your 4 timestamps
     Set dict = CreateObject("scripting.dictionary")
     
    Dim lrr As Integer
    lrr = RANGE("I" & Rows.Count).End(3).Row

'     ActiveSheet.ListObjects.Add(xlSrcRange, RANGE("A1:S" & lrr), , xlYes).Name = "TBL_Jobs_temp"
     
     Set lo = Sheets("temp_sheet").ListObjects("TBL_Jobs_temp")     'table with your data
     arr = lo.DataBodyRange.Value2     'read that table to an array
     ReDim Result(1 To UBound(arr), 1 To 1)

     '1st ROUND : find last status at the end of the shift
    For i = 1 To UBound(arr)     'loop through data
          T_Start = arr(i, 11) + arr(i, 12)     'timestamp end of job
          T_Stop = arr(i, 14) + arr(i, 15)     'timestamp end of job
          mykey = arr(i, 7) & Format(arr(i, 11), "\|dd-mm-yyyy")     'job name & start date
          
        If arr(i, 11) = arr(i, 14) Then
          
            If T_Stop <= arr(i, 11) + TimeSerial(15, 0, 0) Then     'job must end before next day 3PM
               If Not dict.exists(mykey) Then
                    dict(mykey) = Array(T_Stop, arr(i, 10))
               Else
                    If dict(mykey)(0) < T_Stop Then dict(mykey) = Array(T_Stop, arr(i, 10))     '---> for that job and that startdate, the last endmoment & status
               End If
            Else
            '   MsgBox "Listrow " & i & vbTab & arr(i, 1) & vbTab & lo.DataBodyRange(i, 1).Address & vbLf & "job ran from " & Format(T_Start, "dd-mmm hh:mm") & " until " & Format(T_Stop, "dd-mmm hh:mm") & vbLf & "didn't stop before " & Format(arr(i, 3) + 1 + TimeSerial(15, 0, 0), "dd-mmm hh:mm")
               Result(i, 1) = "not within the shift"
          End If
     
                    
          Else
          
            If T_Stop <= arr(i, 11) + 1 + TimeSerial(15, 0, 0) Then     'job must end before next day 3PM
                 If Not dict.exists(mykey) Then
                      dict(mykey) = Array(T_Stop, arr(i, 10))
                 Else
                      If dict(mykey)(0) < T_Stop Then dict(mykey) = Array(T_Stop, arr(i, 10))     '---> for that job and that startdate, the last endmoment & status
                 End If
            Else
             '    MsgBox "Listrow " & i & vbTab & arr(i, 1) & vbTab & lo.DataBodyRange(i, 1).Address & vbLf & "job ran from " & Format(T_Start, "dd-mmm hh:mm") & " until " & Format(T_Stop, "dd-mmm hh:mm") & vbLf & "didn't stop before " & Format(arr(i, 3) + 1 + TimeSerial(15, 0, 0), "dd-mmm hh:mm")
                 Result(i, 1) = "not within the shift"
            End If
     
     
        End If
     
    Next

     '2nd ROUND : add status corresponding with status "end of shift"
     For i = 1 To UBound(arr)     'loop through data
          If Len(Result(i, 1)) = 0 Then     'no blocking conditions
               mykey = arr(i, 1) & Format(arr(i, 11), "\|dd-mm-yyyy")    'key within dictionary
               Result(i, 1) = dict(mykey)(1)     'last known status
          End If
     Next

     lo.ListColumns("Final Status").DataBodyRange.Value = Result     'write array to listobject

 

[6StringJazzer]

What error number and error message do you get? The format in the worksheet should never cause an error when code assigns data. Your assumption that problem is related to the format may be wrong.

 

[bobbyexcel]

It says type mismatch at line (Result(i, 1) = dict(mykey)(1) 'last known status)

 

[Alex Blakenburg]

I haven't run your code but firstly, is there any reason you have Set lo when you already have a variable ListObj ?
When it errors out can you go to Excel hit <F5> select the table name TBL_Jobs_temp, then hit enter.
Does it select the databody and have do you have more than 1 row in the selected area ?