Adding a row after last instances of dates

[saracat2012]

Hello again all. My brain hurts trying to figure out this one. I have a spreadsheet of all open orders, listed by date. I'm trying to find the last instance of a workday date, insert a row, format the row, and add text to the first cell. I can get the formatting part pretty easily, the tricky bit is finding the last instance of the workday and inserting the row. Attached is a before and after shot of what I'm trying to do. (I already have a macro that conditionally formats based on today's date and the workday function color in the dates.)

cards.xlsx
	A	B	C
1	Date	Product
2	7/1/2023	Prod 1
3	7/5/2023	Prod 2
4	7/20/2023	Prod 5
5	7/21/2023	Prod 3
6	7/24/2023	Prod 7
7	7/24/2023	Prod 4
8	7/25/2023	Prod 8
9	7/26/2023	Prod 100
10	7/26/2023	Prod 10
11	7/27/2023	Prod 42
12	7/28/2023	Prod 937
13	7/31/2023
14	8/1/2023
15
16	Date	Product
17	7/1/2023	Prod 1
18	7/5/2023	Prod 2
19	7/20/2023	Prod 5
20	7/21/2023	Prod 3
21	Due Today/Overdue
22	7/24/2023	Prod 7
23	7/24/2023	Prod 4
24	Day 1
25	7/25/2023	Prod 8
26	Day 2
27	7/26/2023	Prod 100
28	7/26/2023	Prod 10
29	Day 3
30	7/27/2023	Prod 42
31	Day 4
32	7/28/2023	Prod 937
33	Day 5
34	7/31/2023
35	8/1/2023
Sheet2

 

[RudRud]

test1.xlsb
	A	B	C	D	E	F	G	H
1	Date	Product		255			Date	Product
2	7/1/2023	Prod 1		49407	Due Today/Overdue		7/1/2023	Prod 1
3	7/5/2023	Prod 2		65535	Day 1		7/5/2023	Prod 2
4	7/20/2023	Prod 5		5296274	Day 2		7/20/2023	Prod 5
5	7/21/2023	Prod 3		12611584	Day 3		7/21/2023	Prod 3
6	7/24/2023	Prod 7		10498160	Day 4		7/24/2023	Prod 4
7	7/24/2023	Prod 4		16777215	Day 5		7/25/2023	Prod 8
8	7/25/2023	Prod 8					7/5/2023	Prod 2
9	7/26/2023	Prod 100					7/20/2023	Prod 5
10	7/26/2023	Prod 10					7/24/2023	Prod 7
11	7/27/2023	Prod 42					7/24/2023	Prod 4
12	7/28/2023	Prod 937					7/25/2023	Prod 8
13	7/31/2023						7/26/2023	Prod 100
14	8/1/2023						7/26/2023	Prod 10
15	7/24/2023	Prod 7					7/27/2023	Prod 42
16	7/24/2023	Prod 4					7/28/2023	Prod 937
17	7/25/2023	Prod 8					7/31/2023
18	7/26/2023	Prod 100					7/5/2023	Prod 2
19	7/26/2023	Prod 10					7/24/2023	Prod 7
20	7/27/2023	Prod 42					7/24/2023	Prod 4
21	7/28/2023	Prod 937					7/25/2023	Prod 8
22	7/1/2023	Prod 1					7/26/2023	Prod 100
23	7/5/2023	Prod 2					7/26/2023	Prod 10
24	7/20/2023	Prod 5					7/27/2023	Prod 42
25	7/21/2023	Prod 3					7/28/2023	Prod 937
26	7/24/2023	Prod 7					7/31/2023
27	7/24/2023	Prod 4					Due Today/Overdue
28	7/25/2023	Prod 8					7/24/2023	Prod 7
29	7/26/2023	Prod 100					7/24/2023	Prod 4
30	7/26/2023	Prod 10					7/24/2023	Prod 7
31	7/27/2023	Prod 42					7/1/2023	Prod 1
32	7/28/2023	Prod 937					7/1/2023	Prod 1
33	7/31/2023						7/20/2023	Prod 5
34	8/1/2023						7/21/2023	Prod 3
35	7/24/2023	Prod 7					Day 1
36	7/24/2023	Prod 4					7/25/2023	Prod 8
37	7/25/2023	Prod 8					7/26/2023	Prod 100
38	7/26/2023	Prod 100					7/21/2023	Prod 3
39	7/26/2023	Prod 10					7/24/2023	Prod 4
40	7/27/2023	Prod 42					7/25/2023	Prod 8
41	7/28/2023	Prod 937					7/26/2023	Prod 100
42	7/20/2023	Prod 5					7/28/2023	Prod 937
43	7/21/2023	Prod 3					7/20/2023	Prod 5
44	7/24/2023	Prod 7					7/21/2023	Prod 3
45	7/24/2023	Prod 4					7/24/2023	Prod 7
46	7/25/2023	Prod 8					7/24/2023	Prod 4
47	7/26/2023	Prod 100					7/25/2023	Prod 8
48	7/26/2023	Prod 10					Day 2
49	7/27/2023	Prod 42					7/26/2023	Prod 100
50	7/28/2023	Prod 937					7/26/2023	Prod 10
51	7/31/2023						7/26/2023	Prod 10
52	8/1/2023						7/27/2023	Prod 42
53	7/24/2023	Prod 7					7/28/2023	Prod 937
54	7/24/2023	Prod 4					8/1/2023
55	7/25/2023	Prod 8					7/28/2023	Prod 937
56	7/26/2023	Prod 100					7/31/2023
57	7/26/2023	Prod 10					8/1/2023
58	7/27/2023	Prod 42					7/26/2023	Prod 10
59	7/28/2023	Prod 937					7/27/2023	Prod 42
60	7/1/2023	Prod 1					7/28/2023	Prod 937
61	7/5/2023	Prod 2					Day 3
62	7/20/2023	Prod 5					7/27/2023	Prod 42
63	7/21/2023	Prod 3					7/24/2023	Prod 7
64	7/24/2023	Prod 7					7/24/2023	Prod 7
65	7/24/2023	Prod 4					7/24/2023	Prod 4
66	7/25/2023	Prod 8					7/25/2023	Prod 8
67	7/26/2023	Prod 100					7/26/2023	Prod 100
68	7/26/2023	Prod 10					Day 4
69	7/27/2023	Prod 42					7/28/2023	Prod 937
70	7/28/2023	Prod 937					7/26/2023	Prod 10
71	7/31/2023						7/26/2023	Prod 100
72	8/1/2023						7/26/2023	Prod 10
73	7/24/2023	Prod 7					7/27/2023	Prod 42
74	7/24/2023	Prod 4					8/1/2023
75	7/25/2023	Prod 8					7/24/2023	Prod 7
76	7/26/2023	Prod 100					7/24/2023	Prod 4
77	7/26/2023	Prod 10					7/25/2023	Prod 8
78	7/27/2023	Prod 42					7/26/2023	Prod 100
79	7/28/2023	Prod 937					7/26/2023	Prod 10
80							7/27/2023	Prod 42
81							7/28/2023	Prod 937
82							Day 5
83							7/31/2023
84							8/1/2023
85							7/27/2023	Prod 42
Sheet1

Result in Column G:H,

You need to copy column D:E (for internal dictionary to detect)

Once you've finished paste into column D:E, you may run the code ( right click sheet1 -> view code -> Paste below code) and run by clicking f5

Option Explicit
Sub test()
application.screenupdating = false
Dim ws As Worksheet
'Dim dict As New Dictionary
Dim i%, a As Variant, k%, m%
Dim ss As Range
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Set ws = Sheets("sheet1") 'May change into your desire sheet
ReDim b(1 To 5000, 1 To 4)
m = 1
'Store recorded D:E Columns into array
With ws
    a = .Range("d1:e" & .Cells(Rows.Count, "d").End(xlUp).Row).Value
    [g1:h100000].Clear 'Clear values and format
    [g1].Value = "Date"
    [h1].Value = "Product"
End With

For i = 1 To UBound(a, 1)
    If Not dict.Exists(a(i, 1)) Then 'If Red color not existing then
            k = k + 1
            dict.Add a(i, 1), a(i, 2) 'Add Red into Dict, Item = Day
            If m <> 1 Then 'For Item due today / Day
                m = m + 1
                Cells(m, "g").Value = dict.Item(a(i, 1))
                Cells(m, "g").Interior.Color = vbBlack
                Cells(m, "g").Font.Color = vbWhite
            End If
            For Each ss In Range("a2:a" & Cells(Rows.Count, "a").End(xlUp).Row) 'Loop through ranges check red color
                If dict.Exists(ss.Interior.Color) Then 'If range got red color
                    'lrow = Cells(Rows.Count, "J").End(xlUp).Row
                    m = m + 1
                    Range("A" & ss.Row & ":B" & ss.Row).Copy Cells(m, "g") 'Copy values to G
               End If
            Next ss
    dict.RemoveAll 'after finished remove dictionary red then record 2nd one
    End If
Next i

application.screenupdating = true

End Sub

 

[saracat2012]

Thanks for the help. I never would have figured that out on my own.

 

[RudRud]

Thanks for the help. I never would have figured that out on my own.

Glad to assist, If you have any further questions, please don't hesitate to ask/share with us