Insert a row every week on a specific day

[riley454]

I have several years of data sorted by date and I want to have a separation between each week by inserting a new row on every Wednesday of every week for easier viewing/manipulation of each week's data.

Some days have single entries, some have multiple entries and some days (and weeks) have no data at all so there is no consistent insert row every "N'th" option. Often there are Wednesdays with no data so looping through dates looking for Wednesdays and inserting a row also will not work as there sometimes may not be a Wednesday to find but I still need a row inserted that week.

I'm having trouble visualizing the workflow to achieve this. My attempts to develop a workflow before creating a macro have included adding helper cells to convert dates to days with "dddd" and/or assigning numerical values to days, among other things, but I'm really unsure where to begin

 

[HaHoBe]

Hi riley454,

maybe like this (code works on the active sheet, adjust start row and column to suit and test it on a copy of your data before applying it on live data):

Sub MrE1222073_1613E0B()
'https://www.mrexcel.com/board/threads/insert-a-row-every-week-on-a-specific-day.1222073/
Dim dteLastWednesday As Date
Dim lngCounter As Long

Const cstrColDate As String = "D"

Application.ScreenUpdating = False
lngCounter = 2
With Cells(lngCounter, cstrColDate)
  dteLastWednesday = .Value + (7 - Weekday(.Value, vbWednesday))
End With

Do While Cells(lngCounter, cstrColDate).Value <> ""
  If Cells(lngCounter, cstrColDate).Value <= dteLastWednesday Then
    lngCounter = lngCounter + 1
  Else
    dteLastWednesday = dteLastWednesday + 7
    Rows(lngCounter).Insert xlShiftDown
    lngCounter = lngCounter + 2
  End If
Loop

Application.ScreenUpdating = True
End Sub

Ciao,
Holger

 

[HaHoBe]

Hi riley454,

the updated code should take care of longer gaps between dates:

Sub MrE1222073_1613E0B_V2()
'https://www.mrexcel.com/board/threads/insert-a-row-every-week-on-a-specific-day.1222073/
Dim dteLastWednesday As Date
Dim lngCounter As Long

Const cstrColDate As String = "D"

Application.ScreenUpdating = False
lngCounter = 2
With Cells(lngCounter, cstrColDate)
  dteLastWednesday = .Value + (7 - Weekday(.Value, vbWednesday))
End With

Do While Cells(lngCounter, cstrColDate).Value <> ""
  With Cells(lngCounter, cstrColDate)
    If .Value <= dteLastWednesday Then
      lngCounter = lngCounter + 1
    Else
      If .Value > dteLastWednesday And .Value - dteLastWednesday > 7 Then
        Do While .Value > dteLastWednesday
          dteLastWednesday = dteLastWednesday + 7
        Loop
        Rows(lngCounter).Insert xlShiftDown
        lngCounter = lngCounter + 2
      Else
        dteLastWednesday = dteLastWednesday + 7
        Rows(lngCounter).Insert xlShiftDown
        lngCounter = lngCounter + 2
      End If
    End If
  End With
Loop

Application.ScreenUpdating = True
End Sub

Ciao,
Holger

 

[riley454]

Thanks Holger
I just tried both versions but I get a Runtime error 13, Type mismatch.

I've stepped through it with F8 and it happens here

     With Cells(lngCounter, cstrColDate)
  >>>  dteLastWednesday = .Value + (7 - Weekday(.Value, vbWednesday))
     End With

I've been a bit busy on other things so I haven't had a chance to look into deeper just yet. I should be able to play around with it in the next few days and I'll post an update

 

[HaHoBe]

Hi riley454,

I assumed the data to start in the second row, have you adapted

lngCounter = 2

to suit and is it a real date in the cell or a text displayed as date? If it is text you should use the Data Convserion CDate for the value.

Writing the code I had real dates in the cells so everything worked smoothly for me.

Ciao,
Holger

 

[riley454]

Ah yes! Apologies I had not made that adjustment

Prior to realising my oversight I had a moment of clarity and created a super simple solution that would suit my needs for this as a once-off requirement which I have outlined below.

Thanks Holger for your macro. It will help many people. One of the great things about this forum is having so many different minds and perspectives to achieve a result. Hopefully others will find as much use for my cheap shortcut

My Method
My dates are sorted from newest to oldest.
The common date format in my location is dd/mm/yyyy.
Modify to suit your requirements

Using an empty column (K) formatted as a date, I added the date of the next Wednesday after my latest data into K1 (eg: 16/11/2022)
In "K2" I added the date of the previous Wednesday (09/11/2022)
Select cells K1 and K2
Drag the autofill box down until you have passed the earliest date of data
Copy all those dates from K:K
Paste below the last existing dates of the main data (in my case "column A")
Select column A
Sort "newest to oldest" & keep "expand the selection" checked
The new list of Wednesday dates are now included in the appropriate location as a new row

It might not be the prettiest way but it was quick and it worked in this case. Alternatively, Holger's macro may be more appropriate especially if it needs to be done repetitively or on more complex datasets