Sub Victor75()
Dim n As Long, tbl, arr(), I As Long, J As Long, k As Long
With ActiveSheet
tbl = .Cells(1).CurrentRegion.Resize(, 4).Value2
For I = 1 To UBound(tbl)
For J = 3 To 4
ReDim Preserve arr(3, k + 1)
arr(0, k) = IIf(k Mod 2 = 0, tbl(I, 1), "")
arr(1, k) = IIf(k Mod 2 = 0, "HI", "LO")
arr(2, k) = tbl(I, J)
k = k + 1
Next J
Next I
With .Cells(1, 8)
.Resize(k, 3).Value = Application.Transpose(arr)
.Resize(k).NumberFormat = "m/d/yyyy"
End With
End With
End Sub