Hi,
A modification to the code to operate from a different range
changes suggestionCode:Sub kTest21() Dim d As Date, ed As Date Dim r As Range, c As Range Dim i As Long Dim list As Long: list = 21 Set r = Range("d" & Rows.Count).End(xlUp) d = CDate(r.Value2) ed = DateSerial(Year(d), Month(d) + 1, 1) - 1 For i = r.Row To 1 Step -1 Set c = Cells(i, r.Column) If Val(c.Value2) = 0 Then Exit For d = CDate(c.Value2) If ed - d > 1 Then c.Offset(1).Resize(Day(ed) - Day(d) - 1).EntireRow.Insert c.AutoFill c.Resize(Day(ed) - Day(d) + 1) End If ed = CDate(d) Next If Day(ed) > 1 Then c.Offset(1).Resize(Day(ed - 1)).EntireRow.Insert Cells(list, r.Column) = DateSerial(Year(ed), Month(ed), 1) Cells(list, r.Column).AutoFill Cells(list, r.Column).Resize(Day(ed)) End If End Sub




Reply With Quote
Bookmarks