motherindia
Board Regular
- Joined
- Oct 15, 2015
- Messages
- 218
Hi Sir,
The following code plot the days between 2 dates into separate column. However, I need to get number of days between 2 dates monthwise;
[TABLE="width: 338"]
<tbody>[TR]
[TD]ID[/TD]
[TD]S Date [/TD]
[TD]E Date[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD="align: right"]01/06/2017[/TD]
[TD="align: right"]15/07/2017[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD="align: right"]16/07/2017[/TD]
[TD="align: right"]12/08/2017[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD="align: right"]14/08/2017[/TD]
[TD="align: right"]30/08/2017[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 2"]output should be[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]ID[/TD]
[TD]Jun'17[/TD]
[TD]Jul'17[/TD]
[TD]Aug'17[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD="align: right"]30[/TD]
[TD="align: right"]31[/TD]
[TD="align: right"]30[/TD]
[/TR]
</tbody><colgroup><col><col><col><col></colgroup>[/TABLE]
http://www.ozgrid.com/forum/showthread.php?t=197056&page=2&
sub test
Dim a, i As Long, ii As Long, w, DD, ub As Long
a = Cells(1).CurrentRegion.Value
With CreateObject("Scripting.Dictionary")
For i = 2 To UBound(a, 1)
If Not .exists(a(i, 1)) Then
Redim w(1 To 2)
For ii = 1 To 2
w(ii) = a(i, ii)
Next
.Item(a(i, 1)) = w
Else
w = .Item(a(i, 1))
End If
ub = UBound(w)
DD = DateDiff("d", a(i, 3), a(i, 4)) + 1
Redim Preserve w(1 To UBound(w) + DD)
For ii = ub + 1 To UBound(w)
w(ii) = a(i, 3) + ii - ub - 1
Next
.Item(a(i, 1)) = w
Next
For i = 0 To .Count - 1
Sheets("Sheet2").Select
Range("A1").Select
Cells(i + 1, "a").Resize(, UBound(.items()(i))) = .items()(i)
Next
End With
End sub
Regards,
motherindia
The following code plot the days between 2 dates into separate column. However, I need to get number of days between 2 dates monthwise;
[TABLE="width: 338"]
<tbody>[TR]
[TD]ID[/TD]
[TD]S Date [/TD]
[TD]E Date[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD="align: right"]01/06/2017[/TD]
[TD="align: right"]15/07/2017[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD="align: right"]16/07/2017[/TD]
[TD="align: right"]12/08/2017[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD="align: right"]14/08/2017[/TD]
[TD="align: right"]30/08/2017[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 2"]output should be[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]ID[/TD]
[TD]Jun'17[/TD]
[TD]Jul'17[/TD]
[TD]Aug'17[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD="align: right"]30[/TD]
[TD="align: right"]31[/TD]
[TD="align: right"]30[/TD]
[/TR]
</tbody><colgroup><col><col><col><col></colgroup>[/TABLE]
http://www.ozgrid.com/forum/showthread.php?t=197056&page=2&
sub test
Dim a, i As Long, ii As Long, w, DD, ub As Long
a = Cells(1).CurrentRegion.Value
With CreateObject("Scripting.Dictionary")
For i = 2 To UBound(a, 1)
If Not .exists(a(i, 1)) Then
Redim w(1 To 2)
For ii = 1 To 2
w(ii) = a(i, ii)
Next
.Item(a(i, 1)) = w
Else
w = .Item(a(i, 1))
End If
ub = UBound(w)
DD = DateDiff("d", a(i, 3), a(i, 4)) + 1
Redim Preserve w(1 To UBound(w) + DD)
For ii = ub + 1 To UBound(w)
w(ii) = a(i, 3) + ii - ub - 1
Next
.Item(a(i, 1)) = w
Next
For i = 0 To .Count - 1
Sheets("Sheet2").Select
Range("A1").Select
Cells(i + 1, "a").Resize(, UBound(.items()(i))) = .items()(i)
Next
End With
End sub
Regards,
motherindia