Loop qnd improvement needed

[TheFrenchBeginner]

Hi guys,

I read this forum since a few months but this is my first post.

Indeed, I need your help for the second macro of my life

I am a financial auditor and I would like to create a macro that found the last coupon date of a bond, based on the maturity date, and before a certain date (the last day of the financial period).

For a bond you can receive a coupon once a year, two times a year, four times and 12 times.

So for example, if the last day of my financial period is 30/06/2018, if I have a bond with a maturity as at 30/10/2018 and with a coupon once a year I will ask excel to take the 30/10/218, and to remove 12 months (one a year coupon) until the date found is before the 30/06/2018. In my example the result will be 30/10/2017.

I created a macro that do exactly what I need but I have two “issues”.

The biggest one is that I do not know How to loop my set of Instructions for each bond (I called it line 1, line 2 in my VBA code). So I copy/paste my code 10 times to cover 10 bonds but it is not a good solution since I can have up to 1000 bonds to cover.

My second “issue” is that I need to change the frequency in times per year in month(s) for the calculation. So the rule is:
1 time per year = 12 months
2 times per year = 6 months
4 times per year = 3 months
12 times per year = 1 month

My problem here is that I do not know how to use the loop “For Next” with the command End(xlDown). For the moment I gave to excel the arbitrary number 100 but If I have more than 100 bonds I will have an issue. If I put this figure at 2000 for example the macro is really slow.

I hope that is clear for you.

All my apologies for my English (I am French) and for my macro (it is pretty ugly for the moment).

Thank you very much for your help J

PS : I will copy paste my code here since I do not know how to attach my file.

Sub Lastcoupondate()
ActiveSheet.Cells.Copy
Sheets.Add After:=ActiveSheet
Range("A1").Select
ActiveSheet.Paste
Dim i As Integer
Range("D3").Select
For i = 3 To 100
     If ActiveCell.Offset(0, -3) = 1 Then Cells(i, 4).Value = 12
     If ActiveCell.Offset(0, -3) = 2 Then Cells(i, 4).Value = 6
     If ActiveCell.Offset(0, -3) = 4 Then Cells(i, 4).Value = 3
     If ActiveCell.Offset(0, -3) = 12 Then Cells(i, 4).Value = 1
ActiveCell.Offset(1, 0).Select
Next i
Columns("B:B").Select
Selection.Copy
Columns("E:E").Select
ActiveSheet.Paste
'Line 1
Range("F5").Activate
Do Until ActiveCell.Offset(0, -1) < Range("C2")
ActiveCell = DateAdd("m", -Range("D5"), ActiveCell.Offset(0, -1))
ActiveCell.Offset(0, 1).Activate
Loop
Range("F5").End(xlToRight).Copy
ActiveSheet.Previous.Select
Range("C5").Select
ActiveSheet.Paste
ActiveSheet.Next.Select
'Line 2
Range("F6").Activate
Do Until ActiveCell.Offset(0, -1) < Range("C2")
ActiveCell = DateAdd("m", -Range("D6"), ActiveCell.Offset(0, -1))
ActiveCell.Offset(0, 1).Activate
Loop
Range("F6").End(xlToRight).Copy
ActiveSheet.Previous.Select
Range("C6").Select
ActiveSheet.Paste
ActiveSheet.Next.Select
'Line 3
Range("F7").Activate
Do Until ActiveCell.Offset(0, -1) < Range("C2")
ActiveCell = DateAdd("m", -Range("D7"), ActiveCell.Offset(0, -1))
ActiveCell.Offset(0, 1).Activate
Loop
Range("F7").End(xlToRight).Copy
ActiveSheet.Previous.Select
Range("C7").Select
ActiveSheet.Paste
ActiveSheet.Next.Select
'Line 4
Range("F8").Activate
Do Until ActiveCell.Offset(0, -1) < Range("C2")
ActiveCell = DateAdd("m", -Range("D8"), ActiveCell.Offset(0, -1))
ActiveCell.Offset(0, 1).Activate
Loop
Range("F8").End(xlToRight).Copy
ActiveSheet.Previous.Select
Range("C8").Select
ActiveSheet.Paste
ActiveSheet.Next.Select
'Line 5
Range("F9").Activate
Do Until ActiveCell.Offset(0, -1) < Range("C2")
ActiveCell = DateAdd("m", -Range("D9"), ActiveCell.Offset(0, -1))
ActiveCell.Offset(0, 1).Activate
Loop
Range("F9").End(xlToRight).Copy
ActiveSheet.Previous.Select
Range("C9").Select
ActiveSheet.Paste
ActiveSheet.Next.Select
'Line 6
Range("F10").Activate
Do Until ActiveCell.Offset(0, -1) < Range("C2")
ActiveCell = DateAdd("m", -Range("D10"), ActiveCell.Offset(0, -1))
ActiveCell.Offset(0, 1).Activate
Loop
Range("F10").End(xlToRight).Copy
ActiveSheet.Previous.Select
Range("C10").Select
ActiveSheet.Paste
ActiveSheet.Next.Select
'Line 7
Range("F11").Activate
Do Until ActiveCell.Offset(0, -1) < Range("C2")
ActiveCell = DateAdd("m", -Range("D11"), ActiveCell.Offset(0, -1))
ActiveCell.Offset(0, 1).Activate
Loop
Range("F11").End(xlToRight).Copy
ActiveSheet.Previous.Select
Range("C11").Select
ActiveSheet.Paste
ActiveSheet.Next.Select
'Line 8
Range("F12").Activate
Do Until ActiveCell.Offset(0, -1) < Range("C2")
ActiveCell = DateAdd("m", -Range("D12"), ActiveCell.Offset(0, -1))
ActiveCell.Offset(0, 1).Activate
Loop
Range("F12").End(xlToRight).Copy
ActiveSheet.Previous.Select
Range("C12").Select
ActiveSheet.Paste
ActiveSheet.Next.Select
'Line 9
Range("F13").Activate
Do Until ActiveCell.Offset(0, -1) < Range("C2")
ActiveCell = DateAdd("m", -Range("D13"), ActiveCell.Offset(0, -1))
ActiveCell.Offset(0, 1).Activate
Loop
Range("F13").End(xlToRight).Copy
ActiveSheet.Previous.Select
Range("C13").Select
ActiveSheet.Paste
ActiveSheet.Next.Select
'Line 10
Range("F14").Activate
Do Until ActiveCell.Offset(0, -1) < Range("C2")
ActiveCell = DateAdd("m", -Range("D14"), ActiveCell.Offset(0, -1))
ActiveCell.Offset(0, 1).Activate
Loop
Range("F14").End(xlToRight).Copy
ActiveSheet.Previous.Select
Range("C14").Select
ActiveSheet.Paste
ActiveSheet.Next.Select
'End of the macro
ActiveSheet.Previous.Select
ActiveSheet.Next.Visible = False
End Sub

 

[Michael M]

If I understand you correctly, this may solve your first set of loops.....test it on a copy of your worksheet.....I'm in the car at the moment !!!
change this

ActiveSheet.Cells.Copy
Sheets.Add After:=ActiveSheet
Range("A1").Select
ActiveSheet.Paste
Dim i As Integer
Range("D3").Select
For i = 3 To 100
If ActiveCell.Offset(0, -3) = 1 Then Cells(i, 4).Value = 12
If ActiveCell.Offset(0, -3) = 2 Then Cells(i, 4).Value = 6
If ActiveCell.Offset(0, -3) = 4 Then Cells(i, 4).Value = 3
If ActiveCell.Offset(0, -3) = 12 Then Cells(i, 4).Value = 1
ActiveCell.Offset(1, 0).Select
Next i

TO THIS

Dim lr As Long, r As Long, i As Long
ActiveSheet.Copy After:=ActiveSheet
lr = Cells(Rows.Count, "D").End(xlUp).Row
For i = 3 To lr
If Range("A" & i).value = 1 Then Range("D" & i).Value = 12
If Range("A" & i).value = 2 Then Range("D" & i).Value = 6
If Range("A" & i).value = 4 Then Range("D" & i).Value = 3
If Range("A" & i).value = 12 Then Range("D" & i).Value = 1
Next i

 

[TheFrenchBeginner]

Hi Michael,

Thank you so much for your reply.

I tried but it is not working.

Maybe I did something wrong

Here is a link to download my file.

Maybe it will be easier for you this way :

https://wetransfer.com/downloads/b6...8eab26e56cd0fa3c4200005c20180723075701/00f195

 

[Michael M]

Maybe this

Sub Lastcoupondate()
Dim lr As Long, r As Long, i As Long
Application.ScreenUpdating = False
ActiveSheet.Copy After:=ActiveSheet
lr = Cells(Rows.Count, "B").End(xlUp).Row
    For i = 3 To lr
        If Range("A" & i).Value = 1 Then Range("D" & i).Value = 12
        If Range("A" & i).Value = 2 Then Range("D" & i).Value = 6
        If Range("A" & i).Value = 4 Then Range("D" & i).Value = 3
        If Range("A" & i).Value = 12 Then Range("D" & i).Value = 1
    Next i
Columns("B:B").Copy Columns("E:E")
'Line 1
    For r = 5 To lr
    Range("F" & r).Activate
        Do Until ActiveCell.Offset(0, -1) < Range("C2")
            ActiveCell = DateAdd("m", -Range("D5"), ActiveCell.Offset(0, -1))
            ActiveCell.Offset(0, 1).Activate
        Loop
    Next r
Application.ScreenUpdating = False
End Sub

 

[TheFrenchBeginner]

Thank you very much it works like a charm !!

 

[Michael M]

Excellent ..glad to help