Insert X Rows To Table & Increment Date In Cell

t0ny84 · Sep 3rd 2020

I am currently in the process of trying to customise a Calendar Template (link below).

The workbook has two sheets:

Sheet 1 - Calendar (Front End)

Sheet 2 - Schedule

On Sheet 1 there is an Add Event button which allows users to enter in a Date and Event Name which is then added as a new row to a table on Sheet 2. What I am trying to do is to add the ability to do recurring entries such as Fortnightly and Monthly.

Current Add Button Code

Code

Sub AddEvent()

Lrow = Worksheets("Schedule").Range("B" & Rows.Count).End(xlUp).Row + 1

Worksheets("Schedule").Range("B" & Lrow) = ActiveSheet.Range("N6")

Worksheets("Schedule").Range("C" & Lrow) = ActiveSheet.Range("M6")

ActiveSheet.Range("M6:N6") = ""

SortTable

End Sub

Display More

I found the below thread on this forum which has the same concept that I want but I am unable to get it to work properly. Is there anyone who might know if this is possible and if so what code I would use?

Insert New Row & Increment Number

Calendar Template - https://www.get-digital-help.com/calendar-monthly-view/

Cross Link - https://www.mrexcel.com/board/…ncrementing-date.1144613/

Thanks in advance,

t0ny84

t0ny84 · Sep 3rd 2020

Cross Link - https://www.excelforum.com/exc…-in-cell.html#post5389623

**royUK** · Sep 3rd 2020

An example of your workbook would help

t0ny84 · Sep 3rd 2020

Quote from royUK

An example of your workbook would help

I did include a link to the template website in my original post but here is a copy of the document.

**royUK** · Sep 3rd 2020

What original post?

t0ny84 · Sep 3rd 2020

Quote from royUK

What original post?

Insert X Rows To Table & Increment Date In Cell

Calendar Template - https://www.get-digital-help.com/calendar-monthly-view/

t0ny84 · Sep 4th 2020

Update - After learning more about LOOPS I was able to mash together the following code (if it might help someone in the future)

VBA

Sub AddEvent_modified()
Dim mydate As Date
Dim fdate As String
Dim ix As Integer
Dim cell As Range
Application.ScreenUpdating = False


mydate = Worksheets("Monthly view").Range("M6") 'cell which the user enters the date
fdate = CLng(mydate)
Lrow = Sheet2.Range("B" & Rows.Count).End(xlUp).Row + 1 
lr = Sheet2.Range("B" & Rows.Count).End(xlUp).Row + 1
If IsEmpty(Sheet5.Range("M6")) Or IsEmpty(Sheet5.Range("N6")) Or IsEmpty(Sheet5.Range("o6")) Then 'if a field is left blank
MsgBox "Please review event settings and try again."


ElseIf Sheet5.Range("O6") = "Once Off" Then 'If the event is a once off
Lrow = Sheet2.Range("B" & Rows.Count).End(xlUp).Row + 1
Sheet2.Range("B" & Lrow) = ActiveSheet.Range("N6")
Sheet2.Range("C" & Lrow) = ActiveSheet.Range("M6")
Sheet5.Range("M6:N6") = ""
Exit Sub


ElseIf Sheet5.Range("O6") = "Weekly" Then 'if the event is a weekly event - adds for 52 weeks
For ix = 1 To 52
Sheet2.Range("C" & lr) = fdate
fdate = fdate + 7
lr = lr + 1
Sheet2.Range("B" & Lrow) = Sheet2.Range("N6")
Next ix
Sheet5.Range("M6:N6") = ""
Exit Sub


ElseIf Sheet5.Range("O6") = "Fortnightly" Then 'if the event is a fortnightly event - adds 26 fortnights
For ix = 1 To 27
Sheet2.Range("C" & lr) = fdate
fdate = fdate + 14
lr = lr + 1
Sheet2.Range("B" & Lrow) = Sheet2.Range("N6")
Next ix
Sheet5.Range("M6:N6") = ""
Exit Sub


ElseIf Sheet5.Range("O6") = "Monthly" Then 'if the event is a monthly event - adds 12 months
For ix = 1 To 12
Sheet2.Range("C" & lr) = fdate
fdate = DateAdd("m", 1, fdate)
lr = lr + 1
Sheet2.Range("B" & Lrow) = Sheet2.Range("N6")
Next ix
Sheet5.Range("M6:o6") = ""
End If


Application.ScreenUpdating = True
End Sub

Display More

Insert X Rows To Table & Increment Date In Cell

Participate now!

Share

Tags