insert row by date

[LOSS1574]

I need assistance for the following worksheet: I?m using an excel spreadsheet to keep track of Account names, Id numbers, date received, date entered, date completed. My boss would like me to include rows for Saturdays and Sundays in between each week.

In lieu of an actual account name the name would read Saturday or Sunday and the date received would be the actual date of the day for that week. See the sample #1 and the desired output in sample #2.

And if possible have a macro button to remove those Saturday and Sunday lines.

Thanks for your assistance.

[Aussiebear]

And if you have more than one Account entry per date?

[LOSS1574]

If i have more then one account entry per date.

I do not need any additional sat/sun inbetween. Just one sat/sun at the end of each week throughout the sheet.

[Aussiebear]

Are we to assume that you have existing data that you are wanting to convert with a function?

My first question was based on trying to establish a trigger point for the insertion of two new rows, but as you were unable to clarify that for me, I'll assume that there will be occasions where two or more accounts will occur on any one weekday whose excel value ranges between 2 and 6. I'm now leaning towards the trigger point being the first occurrence of a weekday value of 2 and that the creation of two rows will be above this row.

[LOSS1574]

Are we to assume that you have existing data that you are wanting to convert with a function?

My first question was based on trying to establish a trigger point for the insertion of two new rows, but as you were unable to clarify that for me, I'll assume that there will be occasions where two or more accounts will occur on any one weekday whose excel value ranges between 2 and 6. I'm now leaning towards the trigger point being the first occurrence of a weekday value of 2 and that the creation of two rows will be above this row.


The trigger point being the first occurrence of a weekday value of 2 for the insersation of the 2 new rows is fine.

Thank you

[LOSS1574]

Any one?

[MaximS]

hi LOSS1574,

use following code:


Sub Reorganize()
Dim i, LRow As Long
Dim j As Date
Dim FirstDate, NextDate As Date

LRow = Range("A" & Rows.Count).End(xlUp).Row
For i = LRow To 4 Step -1
FirstDate = Cells(i, 3).Value
NextDate = Cells(i - 1, 3).Value

For j = FirstDate To NextDate Step -1
If Weekday(j, vbMonday) = 6 Or Weekday(j, vbMonday) = 7 Then
Rows(i).EntireRow.Insert
Cells(i, 1).Value = WeekdayName(Weekday(j, vbMonday))
Cells(i, 3).Value = Format(j, "dd-mmm")
End If
Next j
Next i
LRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 3 To LRow
Cells(i, 2).Value = i - 2
Next i
End Sub


or check attachment for solution.

[LOSS1574]

Thanks for your help.

Can we modify the code to acheive the following:

If there accounts on the same days that Saturday and/or Sundays falls the above code will add muliple sat and/or sundays. Can we restrict the code to limit just one Sat/Sun per week.

Thank you,

[LOSS1574]

hi LOSS1574,

use following code:


Sub Reorganize()
Dim i, LRow As Long
Dim j As Date
Dim FirstDate, NextDate As Date

LRow = Range("A" & Rows.Count).End(xlUp).Row
For i = LRow To 4 Step -1
FirstDate = Cells(i, 3).Value
NextDate = Cells(i - 1, 3).Value

For j = FirstDate To NextDate Step -1
If Weekday(j, vbMonday) = 6 Or Weekday(j, vbMonday) = 7 Then
Rows(i).EntireRow.Insert
Cells(i, 1).Value = WeekdayName(Weekday(j, vbMonday))
Cells(i, 3).Value = Format(j, "dd-mmm")
End If
Next j
Next i
LRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 3 To LRow
Cells(i, 2).Value = i - 2
Next i
End Sub


or check attachment for solution.

Additionaly, The code is adding line for friday and saturday in lieu of Saturday and Sunday. :)

[MaximS]

replace previously posted code with:


Sub Reorganize()
Dim i, LRow As Long
Dim j As Date
Dim FirstDate, NextDate As Date

LRow = Range("A" & Rows.Count).End(xlUp).Row
For i = LRow To 4 Step -1
FirstDate = Cells(i, 3).Value
NextDate = Cells(i - 1, 3).Value

If Weekday(NextDate, vbMonday) < 6 And _
Weekday(FirstDate, vbMonday) < 6 Then
For j = FirstDate To NextDate Step -1
If Weekday(j, vbMonday) = 6 Or Weekday(j, vbMonday) = 7 Then
Rows(i).EntireRow.Insert
Cells(i, 1).Value = _
WeekdayName(Weekday(j, vbMonday), False, vbMonday)
Cells(i, 3).Value = Format(j, "dd-mmm")
End If
Next j
End If
Next i
LRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 3 To LRow
Cells(i, 2).Value = i - 2
Next i
End Sub

[LOSS1574]

I replaced the code with the revised version. Only one Saturday/Sunday is entered in the beginning of the table and not one for each week.

The issue with the code happens when there multiple accounts that fall on the same day when a Saturday and/or Sunday. In the event an account falls on the same date the code stops and skips over it an continues on to the next week.

Also, please provide a breif explanation for why we start from the bottom row of the table in lieu of starting with the first row.

Thanks,

[MaximS]

I will change a bit in the code to handle that exception.

The reason why the code starts from the bottom is that the for... next loop changes LRow value each time it's inserting new row. Because LRow is used only once at the begining extra rows doesn't affect the way that loop works.

[MaximS]

there is another attempt to that task:


Sub Reorganize_v2()

Dim i, LRow As Long
Dim j As Date
Dim FirstDate, NextDate As Date

LRow = Range("A" & Rows.Count).End(xlUp).Row
FirstDate = Cells(3, 3).Value
LastDate = Cells(LRow, 3).Value

For i = LRow To 3 Step -1
If Cells(i, 1).Value = "Saturday" Or _
Cells(i, 1).Value = "Sunday" Then
Rows(i).EntireRow.Delete
End If
Next i

LRow = Range("A" & Rows.Count).End(xlUp).Row

For i = FirstDate To LastDate
If Weekday(i, vbMonday) > 5 Then
Cells(LRow + 1 + x, 1).Value = _
WeekdayName(Weekday(i, vbMonday), False, vbMonday)
Cells(LRow + 1 + x, 3).Value = Format(i, "dd-mmm")
x = x + 1
End If
Next i

LRow = Range("A" & Rows.Count).End(xlUp).Row

Range("A3:E" & LRow).Sort Key1:=Range("C3"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

For i = 3 To LRow
Cells(i, 2).Value = i - 2
Next i

Range("A3:E" & LRow).Select

With Selection
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
End Sub

[LOSS1574]

Thank you for the explanation and updated code.

one small problem remains with the filtering when there is multiple accounts on the same received date. The Sunday Row isn't falling in below the Saturday Row. Other accounts are being sorted inbetween the two. please see the attached.