VBA - Help - Idea Needed to Insert Rows if the next date is not consecutive.

[Trying2learnVBA]

Hello,
I am not quite sure how to properly phrase my question.
I am trying to code a macro to insert rows if the date is not the next day.
But I am trying to keep repeated dates.
The highlighted dates came from my data set. The none highlighted dates is where I need rows to be inserted as needed.

Book3
	B								J	K	L
22	Days with Activity								Date	Result Needed
23	1								08/01/22	08/01/22
24	1								08/01/22	08/01/22
25	1								08/01/22	08/01/22
26	1								08/01/22	08/01/22
27	1								08/01/22	08/01/22
28	5								8/5/2022	8/2/2022	VBA to insert rows if the date is not consecutive
29	5								8/5/2022	8/3/2022	Or VBA to insert rows if the Days are not consecutive
30	8								8/8/2022	8/4/2022
31	8								8/8/2022	8/5/2022
32	8								8/8/2022	8/6/2022
33	8								8/8/2022	8/7/2022
34	12								8/12/2022	8/8/2022
35	12								8/12/2022	8/8/2022
36	12								8/12/2022	8/8/2022
37	15								8/15/2022	8/8/2022
38	15								8/15/2022	8/9/2022
39	17								8/17/2022	8/10/2022
40	17								8/17/2022	8/11/2022
41	19								8/19/2022	8/12/2022
42	22								8/22/2022	8/12/2022
43	22								8/22/2022	8/12/2022
44	24								8/24/2022	8/13/2022
45	24								8/24/2022	8/14/2022
46	26								8/26/2022	8/15/2022
47	26								8/26/2022	8/15/2022
48	30								8/30/2022	8/16/2022
49	30								8/30/2022	8/17/2022
50	31								8/31/2022	8/17/2022
51	31								8/31/2022	8/18/2022
52										8/19/2022
53										8/20/2022
54										8/21/2022
55										8/22/2022
56										8/22/2022
57										8/23/2022
58										8/24/2022
59										8/24/2022
60										8/25/2022
61										8/26/2022
62										8/26/2022
63										8/27/2022
64										8/28/2022
65										8/29/2022
66										8/30/2022
67										8/30/2022
68										8/31/2022
69										8/31/2022
Advances.

Here - i am trying to play using the mid formula to extract the date. But I simply want the proper number of rows to be inserted when the numbers or dates are not consecutive. But I do want to keep repeated dates.

Please point me in the right direction.
I can't quite come up with the right logic for an If else statement.

Thank you in advance gurus!!

 

[Micron]

Posting your code (please use code tags - vba button on posting toolbar) would give anyone something to start with. I presume you simply forgot one 8/5 value in column 3?

Or loop over the range and if date value isn't greater by one, calculate the difference. Either loop that many times then insert and shift cells down, or pass the value to another procedure that does the same.

 

[Anthony47]

So you want to create a new list in column K, with the missing days added? Maybe this macro:

Sub AddDaysJtoK()
Dim I As Long, dGap As Long, J As Long
Dim Extra As Long
'
Cells(2, "K") = Cells(2, "J")
For I = 3 To Cells(Rows.Count, "J").End(xlUp).Row
    dGap = Cells(I, "J") - Cells(I - 1, "J")
    If dGap > 1 Then
'        Cells(I, "J").Resize(dGap - 1, 1).EntireRow.Insert Shift:=xlDown
        For J = 1 To dGap - 1
            Cells(I + Extra, "K") = Cells(I - 1, "J").Value + J
            Extra = Extra + 1
        Next J
        Cells(I + Extra, "K") = Cells(I, "J")
    Else
        Cells(I + Extra, "K") = Cells(I, "J")
    End If
Next I
MsgBox ("Completed")
End Sub

Try...

 

[Trying2learnVBA]

So you want to create a new list in column K, with the missing days added? Maybe this macro:

Sub AddDaysJtoK()
Dim I As Long, dGap As Long, J As Long
Dim Extra As Long
'
Cells(2, "K") = Cells(2, "J")
For I = 3 To Cells(Rows.Count, "J").End(xlUp).Row
    dGap = Cells(I, "J") - Cells(I - 1, "J")
    If dGap > 1 Then
'        Cells(I, "J").Resize(dGap - 1, 1).EntireRow.Insert Shift:=xlDown
        For J = 1 To dGap - 1
            Cells(I + Extra, "K") = Cells(I - 1, "J").Value + J
            Extra = Extra + 1
        Next J
        Cells(I + Extra, "K") = Cells(I, "J")
    Else
        Cells(I + Extra, "K") = Cells(I, "J")
    End If
Next I
MsgBox ("Completed")
End Sub

Try...

Ok This is exactly what I am trying to do..

TEmp Adv & Mats.xlsm
	A	B								J	K	L	M	N	O															AD	AE	AF
1		Advances									Date - Month-Day-Year			Mid Formula to get the day
2	Advance Type	Advance Number								.Advance Amount	.Funding Date	.Maturity Date	.Initial Interest Rate	.Day	Diff
3	FD-FHLB_ADV_LT_3M	3614501								44,830.00	08/01/2022	9/26/2022	2.42%	1	-1																1
4	FD-FHLB_ADV_LT_3M	3614502								44,839.00	08/05/2022	10/5/2022	2.45%	5	3																Insert 3 rows
5	FD-FHLB_ADV_LT_3M	3614503								44,826.00	08/08/2022	9/22/2022	2.41%	8	2
6	FD-FHLB_ADV_LT_3M	3614504								44,827.00	08/08/2022	9/23/2022	2.41%	8	-1
7	FD-FHLB_ADV_LT_3M	3614505								44,841.00	08/08/2022	10/7/2022	2.50%	8	-1																5
8	FD-FHLB_ADV_LT_3M	3614506								44,847.00	08/15/2022	10/13/2022	2.60%	15	6																Insert 2 rows
9	FD-FHLB_ADV_LT_3M	3614507								44,851.00	08/17/2022	10/17/2022	2.57%	17	1
10	FD-FHLB_ADV_LT_3M	3614508								44,853.00	08/22/2022	10/19/2022	2.68%	22	4																8
11	FD-FHLB_ADV_LT_3M	3614509								44,855.00	08/26/2022	10/21/2022	2.75%	26	3																8
12	FD-FHLB_ADV_LT_3M	3614510								44,832.00	08/30/2022	9/28/2022	2.51%	30	3																8
13	FD-FHLB_ADV_LT_3M	3614511								44,859.00	08/30/2022	10/25/2022	2.80%	30	-1
14	FD-FHLB_ADV_LT_3M	3614512								44,845.00	08/31/2022	10/11/2022	2.68%	31	0																Insert 6 rows
15	FD-FHLB_ADV_LT_3M	3614513								44,861.00	08/31/2022	10/27/2022	2.88%	31	-1
16	Total	13								582,966.00
17
18		I Need a loop to insert rows if (O3 & LR) is >0
19		The number of rows to be inserted is the diff number in colum (O)																													15
20
21		For instance, I need 4 rows to be inserted below row 3. Then 3 rows to be inserted then skip the zeroes and insert 7 rows insert 2 rows etc.																													17
22		End result should be all the days in a given month. 1-31. I'll have
23																															All the way to 8/31/2022
Advances.

Cell Formulas
Range	Formula
K3:K15	K3	=TEXT([@[Funding Date]],"Mm/DD/YYYY")
L3:L15	L3	=[@[Maturity Date]]
M3:M15	M3	=[@[Initial Interest Rate]]/100
N3:N15	N3	=MID([@[.Funding Date]],4,2)*1
O3	O3	=([@[.Day]]-1)-1
O4:O15	O4	=([@[.Day]]-N3)-1
B16	B16	=SUBTOTAL(103,[Advance Number])
J16	J16	=SUBTOTAL(109,[.Advance Amount])

This is the code I am trying to make work..

Sub AddDaysJtoK()
'Dim I As Long, dGap As Long, J As Long
'Dim Extra As Long
''
'Cells(2, "B") = Cells(2, "C")
'For I = 3 To Cells(Rows.Count, "B").End(xlUp).Row
'    dGap = Cells(I, "C") - Cells(I - 1, "B")
'    If dGap > 1 Then
''        Cells(I, "J").Resize(dGap - 1, 1).EntireRow.Insert Shift:=xlDown
'        For C = 1 To dGap - 1
'            Cells(I + Extra, "C") = Cells(I - 1, "B").Value + B
'            Extra = Extra + 1
'        Next C
'        Cells(I + Extra, "C") = Cells(I, "B")
'    Else
'        Cells(I + Extra, "C") = Cells(I, "B")
'    End If
'Next I
'MsgBox ("Completed")



Dim WB As WB, Adv As WS, Mats As WS
Set WB = ActiveWorkbook
Set Adv = WB.Sheets("Advances")
Set Mats = WB.shetets("Maturities")

With Adv
LastRow1 = Adv.Cells(Adv.Rows.Count, 1).End(xlUp).Row
If .Range("O3" & LastRow) > 0 Then




End Sub

 

[Anthony47]

Ok This is exactly what I am trying to do..

And did you try my code?

 

[Trying2learnVBA]

And did you try my code?

Yes - it gives an error after the first date. Your code is what I have commented out to fit my spreadsheet. I am not sure if I needed column "O" but that's just how I am trying to make it work

would you please add comments as to what each line is doing. I am not good at all with For code.

What does Cells(2, "B") = etc mean, what is the 2 referencing to?
to change it to column O would it be "Cells(15, "O")... ?
For I = 3 - what is this doing?

 

[Trying2learnVBA]

Posting your code (please use code tags - vba button on posting toolbar) would give anyone something to start with. I presume you simply forgot one 8/5 value in column 3?

Or loop over the range and if date value isn't greater by one, calculate the difference. Either loop that many times then insert and shift cells down, or pass the value to another procedure that does the same.

You're correct - I simply forgot one 8/5

 

[Trying2learnVBA]

And did you try my code?

OK,

Based on this exact sheet here:

TEmp Adv & Mats.xlsm
	A	B	C	D	E	F	G	H	I
2	Advance Type	Advance Number	Advance Amount	Trade Date	Funding Date	Maturity Date	Initial Interest Rate	Payment Frequency	First Payment Due Date
3	FD-FHLB_ADV_LT_3M	3614501	150,000,000.00	8/1/2022	08/02/22	9/26/2022	2.42	60	9/26/2022 0:00
4	FD-FHLB_ADV_LT_3M	3614502	100,000,000.00	8/5/2022	08/05/22	10/5/2022	2.45	60	10/5/2022 0:00
5	FD-FHLB_ADV_LT_3M	3614503	150,000,000.00	8/8/2022	08/08/22	9/22/2022	2.41	60	9/22/2022 0:00
6	FD-FHLB_ADV_LT_3M	3614504	150,000,000.00	8/8/2022	08/08/22	9/23/2022	2.41	60	9/23/2022 0:00
7	FD-FHLB_ADV_LT_3M	3614505	150,000,000.00	8/8/2022	08/08/22	10/7/2022	2.5	60	10/7/2022 0:00
8	FD-FHLB_ADV_LT_3M	3614506	100,000,000.00	8/15/2022	08/15/22	10/13/2022	2.6	60	10/13/2022 0:00
9	FD-FHLB_ADV_LT_3M	3614507	100,000,000.00	8/17/2022	08/17/22	10/17/2022	2.57	60	10/17/2022 0:00
10	FD-FHLB_ADV_LT_3M	3614508	150,000,000.00	8/22/2022	08/22/22	10/19/2022	2.68	60	10/19/2022 0:00
11	FD-FHLB_ADV_LT_3M	3614509	100,000,000.00	8/26/2022	08/26/22	10/21/2022	2.75	60	10/21/2022 0:00
12	FD-FHLB_ADV_LT_3M	3614510	150,000,000.00	8/30/2022	08/30/22	9/28/2022	2.51	30	9/28/2022 0:00
13	FD-FHLB_ADV_LT_3M	3614511	150,000,000.00	8/30/2022	08/30/22	10/25/2022	2.8	60	10/25/2022 0:00
14	FD-FHLB_ADV_LT_3M	3614512	100,000,000.00	8/31/2022	08/31/22	10/11/2022	2.68	60	10/11/2022 0:00
15	FD-FHLB_ADV_LT_3M	3614513	100,000,000.00	8/31/2022	08/31/22	10/27/2022	2.88	60	10/27/2022 0:00
Advances

I've changed your code as best as I understand it to fit my needs.
The debugger sayd dGap=0 - I changed the date to 08/02/2022 from 08/01/2022 to see if this would make dGap not be zero

Sub AddDaysJtoK()
Dim I As Long, dGap As Long, J As Long
Dim Extra As Long
'
Cells(2, "E") = Cells(2, "J")
For I = 3 To Cells(Rows.Count, "J").End(xlUp).Row
    dGap = Cells(I, "E") - Cells(I - 1, "J")
    If dGap > 1 Then
'        Cells(I, "J").Resize(dGap - 1, 1).EntireRow.Insert Shift:=xlDown - IS THIS SUPPOSED TO BE COMMENTED OUT OR WAS THIS A TYPO?
        For J = 1 To dGap - 1
            Cells(I + Extra, "E") = Cells(I - 1, "J").Value + J
            Extra = Extra + 1
        Next J
        Cells(I + Extra, "E") = Cells(I, "J")
    Else
        Cells(I + Extra, "E") = Cells(I, "J")
    End If
Next I
MsgBox ("Completed")

End Sub

 

[Micron]

Was beginning to feel ignored . I got this

1​								8/01/22​
1​								8/01/22​
1​								8/01/22​
1​								8/01/22​
1​								8/01/22​
								8/02/22​
								8/03/22​
								8/04/22​
5​								8/05/22​
5​								8/05/22​
								8/06/22​
								8/07/22​
8​								8/08/22​
8​								8/08/22​
8​								8/08/22​
8​								8/08/22​
								8/09/22​
								8/10/22​
								8/11/22​
12​								8/12/22​
12​								8/12/22​
12​								8/12/22​
								8/13/22​
								8/14/22​
15​								8/15/22​
15​								8/15/22​
								8/16/22​
17​								8/17/22​
17​								8/17/22​
								8/18/22​
19​								8/19/22​
								8/20/22​
								8/21/22​
22​								8/22/22​
22​								8/22/22​
								8/23/22​
24​								8/24/22​
24​								8/24/22​
								8/25/22​
26​								8/26/22​
26​								8/26/22​
								8/27/22​
								8/28/22​
								8/29/22​
30​								8/30/22​
30​								8/30/22​
31​								8/31/22​
31​								8/31/22​

with this

Sub insertDates()
Dim rng As Range
Dim i As Integer, Lrow As Integer

Lrow = Cells(Rows.count, "I").End(xlUp).Row
For Each rng In Range("I2:I" & Lrow)
  If rng.Offset(1, 0) - rng > 1 Then
    For i = 1 To (rng.Offset(1, 0) - rng) - 1
       rng.Offset(i, 0).EntireRow.Insert Shift:=xlDown
       rng.Offset(i, 0) = rng + i
     Next
  End If
Next

End Sub

 

[Trying2learnVBA]

Was beginning to feel ignored . I got this

1​								8/01/22​
1​								8/01/22​
1​								8/01/22​
1​								8/01/22​
1​								8/01/22​
								8/02/22​
								8/03/22​
								8/04/22​
5​								8/05/22​
5​								8/05/22​
								8/06/22​
								8/07/22​
8​								8/08/22​
8​								8/08/22​
8​								8/08/22​
8​								8/08/22​
								8/09/22​
								8/10/22​
								8/11/22​
12​								8/12/22​
12​								8/12/22​
12​								8/12/22​
								8/13/22​
								8/14/22​
15​								8/15/22​
15​								8/15/22​
								8/16/22​
17​								8/17/22​
17​								8/17/22​
								8/18/22​
19​								8/19/22​
								8/20/22​
								8/21/22​
22​								8/22/22​
22​								8/22/22​
								8/23/22​
24​								8/24/22​
24​								8/24/22​
								8/25/22​
26​								8/26/22​
26​								8/26/22​
								8/27/22​
								8/28/22​
								8/29/22​
30​								8/30/22​
30​								8/30/22​
31​								8/31/22​
31​								8/31/22​

with this

Sub insertDates()
Dim rng As Range
Dim i As Integer, Lrow As Integer

Lrow = Cells(Rows.count, "I").End(xlUp).Row
For Each rng In Range("I2:I" & Lrow)
  If rng.Offset(1, 0) - rng > 1 Then
    For i = 1 To (rng.Offset(1, 0) - rng) - 1
       rng.Offset(i, 0).EntireRow.Insert Shift:=xlDown
       rng.Offset(i, 0) = rng + i
     Next
  End If
Next

End Sub

This would be the result I want - did this work on the original mini sheet I provided?
How do I adjust it for my actual sheet the mini sheet provided in my last post?

when I run it as is - I get an error. The debugger goes to "If rng.Offset(1,0)-rng>1 then
When I hover over rng.offset it says 9/26/22 and rng>1 says "First Payment due date"