Loop qnd improvement needed

TheFrenchBeginner

New Member
Joined
Jul 23, 2018
Messages
3
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.

Code:
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
 
Last edited by a moderator:

Some videos you may like

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
18,889
Office Version
2013
Platform
Windows
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
Code:
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

Code:
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
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
18,889
Office Version
2013
Platform
Windows
Maybe this

Code:
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
 
Last edited:

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
18,889
Office Version
2013
Platform
Windows
Excellent ..glad to help (y)
 

Watch MrExcel Video

Forum statistics

Threads
1,100,191
Messages
5,473,041
Members
406,843
Latest member
David_Welland

This Week's Hot Topics

Top