Add Missing Dates

[PcMax]

Hi,

With the following code to insert the missing dates from an ordered list

2-Apr-14
3-Apr-14
5-Apr-14
6-Apr-14
6-Apr-14
6-Apr-14
7-Apr-14
9-Apr-14
11-Apr-14
11-Apr-14
12-Apr-14
12-Apr-14
12-Apr-14


Sub AddMissingDates()
Dim i As Long: i = 1

Do
If Cells(i + 1, "D") > Cells(i, "D") + 1 Then
Rows(i + 1).Insert xlShiftDown
Cells(i + 1, "D") = Cells(i, "D") + 1
End If
i = i + 1
Loop Until Cells(i + 1, "D") = ""

End Sub

How could I change to display a period from the day= 1 to day = 30

thank you in advance

[snb]

Sub M_snb()
with Cells(1, 4)
.value = DateSerial(Year(.value), Month(.Value), 1)
.AutoFill .Resize(31)
end with
End Sub

[PcMax]

Hi,

Great suggestion.

I need to be able to view multiple times on the same date
The list that I get is the following for research in that period

01-apr-14
02-apr-14
03-apr-14
04-apr-14
05-apr-14
06-apr-14
06-apr-14
06-apr-14
07-apr-14
08-apr-14
09-apr-14
10-apr-14
11-apr-14
11-apr-14
12-apr-14
12-apr-14
12-apr-14
12-apr-14
12-apr-14
12-apr-14
13-apr-14
14-apr-14
15-apr-14
16-apr-14
17-apr-14
18-apr-14
19-apr-14
20-apr-14
21-apr-14
22-apr-14
23-apr-14
24-apr-14
25-apr-14
26-apr-14
27-apr-14
28-apr-14
29-apr-14
30-apr-14

[Admin]

Hi

there might be a better solution. In the meantime try this.


Sub kTest()

Dim d As Date, ed As Date
Dim r As Range, c As Range
Dim i As Long

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)
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.Resize(Day(ed) - 1).EntireRow.Insert
Cells(1, r.Column) = DateSerial(Year(ed), Month(ed), 1)
Cells(1, r.Column).AutoFill Cells(1, r.Column).Resize(Day(ed))
End If

End Sub

[PcMax]

Hi

Excellent solution, with this cycle.

[PcMax]

Hi,

A modification to the code to operate from a different range


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

changes suggestion

[Admin]

Hi


Set r = Cells(Rows.Count, List).End(xlUp)

I assume the variable List is the column number.

[PcMax]

Hi,

Maybe I hid the code:

Dim list As Long: list = 21

I used the variable list to indicate the beginning of the table
To insert the missing days with the code

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

The code works correctly
Thank you so much

[snb]

Sub M_snb()
c00 = Join([transpose(text(date(year(A1),month(A1),0)+row(1:31 ),"yyyy-mm-dd"))], ",")
sq = Filter([transpose(if(A1:A200="","~",if(countif(A1:A200,A1:A200)>1,text(A1:A200,"yyyy-mm-dd"),"~")))], "~", False)

Do Until UBound(sq) = -1
c00 = Replace(c00, sq(0), Join(Filter(sq, sq(0)), ","))
sq = Filter(sq, sq(0), False)
Loop

sq = Split(Replace(c00, "_", ","), ",")
Cells(1, 6).Resize(UBound(sq) + 1) = Application.Transpose(sq)
End Sub