24 hour VBA not working

HansVogelaar 

I've spend hours looking online and apparently it just seems to happen to certain computers, can't see an obvious fix other than to change the code to a split VBA. How would I incorporate in the place of the red part of the code below, or a similar thing:

New code:

Dim x As Double, c As Range
For Each c In Selection
x = c
c = Int(x)
c.NumberFormat = "m/d/yyyy"
c.Offset(0, 1) = Format(x, "hh:mm")
c.Offset(0, 1).NumberFormat = "hh:mm"

Current code:

Sub DoAll()
Dim ws As Worksheet
Dim LastRow As Long, i As Long
Dim tmpArray() As String
Dim Formulas() As Variant
'~~> This is the relevant sheet
Set ws = ThisWorkbook.Sheets("Clockings")
With ws
'Inserts Six Columns at C,D,E,F,G,H
.Range("C:H").EntireColumn.Insert
.Range("C1").Formula = "ID"
.Range("D1").Formula = "Description"
.Range("E1").Formula = "Shift"
.Range("F1").Formula = "Type"
.Range("G1").Formula = "MY"
.Range("H1").Formula = "B"
.Range("V:W").EntireColumn.Insert
.Range("Y:Z").EntireColumn.Insert
.Range("V1").Formula = "Start Date"
.Range("W1").Formula = "Start Time"
.Range("Y1").Formula = "End Date"
.Range("Z1").Formula = "End Time"
'Inserts specific formulae to cells V2 and W2
ReDim Formulas(1 To 2)
Formulas(1) = "=INT(U2)"
Formulas(2) = "=MOD(U2,1)"
.Range("V2:W2").Formula = Formulas
ReDim Formulas(1 To 2)
Formulas(1) = "=IF(X2="""","""",INT(X2))"
Formulas(2) = "=IF(X2="""","""",MOD(X2,1))"
.Range("Y2:Z2").Formula = Formulas
'Inserts specific formulae to cells C2,D2.E2.F2.G2 and H2
ReDim Formulas(1 To 6)
Formulas(1) = "=IFERROR(VLOOKUP(B2,'17 SO'!A:C,2,0),VLOOKUP(B2,'18 SO'!A:C,2,0))"
Formulas(2) = "=IFERROR(VLOOKUP(C2,'17 SO'!B:D,2,0),VLOOKUP(C2,'18 SO'!B:D,2,0))"
Formulas(3) = "=IF(AND(W2>='Reference Sheet'!$C$14,W2<='Reference Sheet'!$C$12),TEXT(V2-1,""ddd"")&"" ""&IF(AND(W2>='Reference Sheet'!$C$12,W2<'Reference Sheet'!$C$13),'Reference Sheet'!$D$12,'Reference Sheet'!$D$13),TEXT(V2,""ddd"")&"" ""&IF(AND(V2>='Reference Sheet'!$C$12,W2<'Reference Sheet'!$C$13),'Reference Sheet'!$D$12,'Reference Sheet'!$D$13))"
Formulas(4) = "=IF(ISNUMBER(SEARCH(""Sling"",D2)),""Sling/Lab"",IF(ISNUMBER(SEARCH(""Dress"",D2)),""NDT Dressing Support"",IF(ISNUMBER(SEARCH(""Downtime"",D2)),""Downtime"",IF(ISNUMBER(SEARCH(""jigs"",D2)),""Jigs"",IF(ISNUMBER(SEARCH(""NC"",C2)),""NCR"",IF(ISNUMBER(SEARCH(""M2"",C2)),""Change"",IF(ISNUMBER(SEARCH(""M3"",C2)),""Change"",""Earning"")))))))"
Formulas(5) = "=MID(C2,4,2)"
Formulas(6) = "=IF(ISNA(VLOOKUP(C2,'1811 SO'!B:B,1,FALSE)), ""III"", ""II"")"
.Range("C2:H2").Formula = Formulas
'Changes number format in Columns B and C to general
.Range("C:H").NumberFormat = "General"
LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
.Range("C2:C" & LastRow).FillDown
.Range("D2:D" & LastRow).FillDown
.Range("E2:E" & LastRow).FillDown
.Range("F2:F" & LastRow).FillDown
.Range("G2:G" & LastRow).FillDown
.Range("H2:H" & LastRow).FillDown
.Range("V2:V" & LastRow).FillDown
.Range("W2:W" & LastRow).FillDown
.Range("Z2:Z" & LastRow).FillDown
.Range("Y2:y" & LastRow).FillDown
Columns("V:W").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Columns("Y:Z").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'delete column U
.Range("U:U").EntireColumn.Delete
.Range("W:W").EntireColumn.Delete
.Range("AI1").Formula = "Role"
.Range("AJ1").Formula = "Squad"
'Changes number format in Columns V to Time
.Range("V:V").NumberFormat = "hh:mm"
.Range("X:X").NumberFormat = "hh:mm"
.Range("U:U").NumberFormat = "dd/mm/yyyy"
.Range("W:W").NumberFormat = "dd/mm/yyyy"
'Inserts specific formulae to cells AI2 and AJ2
ReDim Formulas(1 To 2)
Formulas(1) = "=VLOOKUP(AG2,'Employee Info'!A:C,3,0)"
Formulas(2) = "=VLOOKUP(AH2,'Employee Info'!B:D,3,0)"
.Range("AI2:AJ2").Formula = Formulas
'Changes number format in Columns AI and AJ to general
.Range("AI:AJ").NumberFormat = "General"
LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
.Range("AI2:AI" & LastRow).FillDown
.Range("AJ2:AJ" & LastRow).FillDown
lr = Cells(Rows.Count, "C").End(xlUp).Row 'find last row
For i = lr To 2 Step -1 'loop thru backwards, finish at 2 for headers
If Cells(i, "C").Text = "#N/A" Then Rows(i).EntireRow.Delete
Next i
lrU = Cells(Rows.Count, "U").End(xlUp).Row 'find last row
LrV = Cells(Rows.Count, "V").End(xlUp).Row 'find last row
For i = lrU To 2 Step -1 'loop thru backwards, finish at 2 for headers
'column "U" is column21
If Cells(i, 21).Value < Worksheets("Summary").Cells(3, 7).Value And _
Cells(i, 22).Value < Worksheets("Reference Sheet").Cells(12, 4).Value Or _
Cells(i, 21).Value > Worksheets("Summary").Cells(3, 10).Value And _
Cells(i, 22).Value > Worksheets("Reference Sheet").Cells(13, 4).Value Then
Rows(i).EntireRow.Delete
End If
Next i
End With
End Sub