VBA solution
Sub List_days()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng As Range
Dim InArr() As Variant
Dim OutArr(1 To 1000, 1 To 4) As Variant
Dim Lastrow As Long, r As Long, rr As Long, i As Date
Dim sdate As Date
Application.ScreenUpdating = False
srow = 4 ' Start row of input data
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
ws1.Activate
With ws1
Lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
Set rng = .Range(.Cells(srow, 1), .Cells(Lastrow, 5))
InArr = rng
rr = 0
For r = 1 To UBound(InArr, 1)
sdate = InArr(r, 4)
For i = InArr(r, 4) To InArr(r, 5)
rr = rr + 1
OutArr(rr, 1) = InArr(r, 1)
OutArr(rr, 2) = InArr(r, 2)
OutArr(rr, 3) = 1
OutArr(rr, 4) = sdate
sdate = sdate + 1
Next i
Next r
End With
ws2.Activate
With ws2
.Cells(1, 1) = "ID"
.Cells(1, 2) = "Type"
.Cells(1, 3) = "Days"
.Cells(1, 4) = "Date"
Set rng = .Range(.Cells(2, 1), .Cells(rr + 1, 4))
rng = OutArr
Columns("A:D").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With
Columns("D:D").NumberFormat = "d-mmm-yy"
End With
Application.ScreenUpdating = True
End Sub
Bookmarks