Separate Dates With Blank, Unformatted Row

[Justinian]

I have attached links to two spreadsheets: "Before" and "After." Here is what I am trying to do to "Before" so it ends up looking like "After."

Separate dates as follows: if today is 9/16/19, I need the spreadsheet to only show 9/16, 9/17, and 9/18, removing all other rows of data and separating the three dates with a blank, unformatted row. When I run this report tomorrow (9/17/19), I need 9/17, 9/18, and 9/19 to be the only dates on the report.

How can I accomplish this?

Before
https://app.box.com/s/y9ek52d9dy9tmab2ny2pydo9n87jd6ye

After

https://app.box.com/s/menggrkiitjklwlniyhplvck4gbyl3jv
​

​

 

[Akuini]

Try this:
I put the result in sheet1.

[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1109941a()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1109941-separate-dates-blank-unformatted-row.html[/COLOR][/I]
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] c [COLOR=Royalblue]As[/COLOR] Range
[COLOR=Royalblue]Dim[/COLOR] x [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]String[/COLOR]

x = Range([COLOR=brown]"E2"[/COLOR]).NumberFormat
ary = Array(Format([COLOR=Royalblue]Date[/COLOR], x), Format([COLOR=Royalblue]Date[/COLOR] + [COLOR=crimson]1[/COLOR], x), Format([COLOR=Royalblue]Date[/COLOR] + [COLOR=crimson]2[/COLOR], x))
[COLOR=Royalblue]Set[/COLOR] c = Range([COLOR=brown]"A1"[/COLOR]).CurrentRegion
c.AutoFilter Field:=[COLOR=crimson]5[/COLOR], Criteria1:=ary, [COLOR=Royalblue]Operator[/COLOR]:=xlFilterValues
    
    [COLOR=Royalblue]With[/COLOR] Sheets([COLOR=brown]"Sheet1"[/COLOR])
        .Cells.Clear
        c.Copy .Range([COLOR=brown]"A1"[/COLOR])
        .Range([COLOR=brown]"A1"[/COLOR]).CurrentRegion.Sort Key1:=.[E1], Order1:=xlAscending, Header:=xlYes
        
        [COLOR=Royalblue]For[/COLOR] i = UBound(ary) - [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] LBound(ary) [COLOR=Royalblue]Step[/COLOR] -[COLOR=crimson]1[/COLOR]
            [COLOR=Royalblue]Set[/COLOR] c = .Range([COLOR=brown]"A1"[/COLOR]).CurrentRegion.Offset([COLOR=crimson]1[/COLOR]).Columns([COLOR=brown]"E"[/COLOR]).Find(What:=ary(i), LookIn:=xlValues, lookAt:=xlWhole, _
            SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=[COLOR=Royalblue]False[/COLOR], SearchFormat:=[COLOR=Royalblue]False[/COLOR])
            [COLOR=Royalblue]If[/COLOR] [COLOR=Royalblue]Not[/COLOR] c [COLOR=Royalblue]Is[/COLOR] [COLOR=Royalblue]Nothing[/COLOR] [COLOR=Royalblue]Then[/COLOR] c.Offset([COLOR=crimson]1[/COLOR]).EntireRow.Insert xlShiftDown
                            
        [COLOR=Royalblue]Next[/COLOR]
    [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]With[/COLOR]

[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]

 

[Justinian]

Thank you for responding.

I get an error "Can't execute code in break mode" and the code that does run does not separate dates with a blank, unformatted row. I would like the result to remain on the same tab, not create a second tab because it would be unformatted data.

 

[Akuini]

Are you saying the code doesn't work on your sample file or on your actual data?

 

[Justinian]

I installed your code on the file below, named "Today" and when I run the macro, I get a run-time error '9': subscript out of range.

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]https://app.box.com/s/64rd7i85omis3v1hcsp9impr2dkothi2


[/FONT]

 

[Akuini]

Try this:
It still put the result in sheet1 (because it easier to code), but the format will be the same.
Note: sheet1 must be exist before you run the code.

https://www.dropbox.com/s/remg40ifs551smg/Today 1.xlsm?dl=0

 

[Justinian]

No, that is not working either because I am getting a run-time error '1004':

AutoFilter method of Range class failed
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]c.AutoFilter Field:=5, Criteria1:=ary, Operator:=xlFilterValues[/FONT]

 

[Akuini]

Hm, I'm not sure why, because it works for me as you can see with the result in sheet1.

Sheet "Make Ready Board" must be the active sheet when you run the code!

 

[Justinian]

I copied your code and installed into my spreadsheet but it is not working (same run-time error).

 

[Akuini]

Hm, let's try this one:

[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1109941a()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1109941-separate-dates-blank-unformatted-row.html[/COLOR][/I]
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] c [COLOR=Royalblue]As[/COLOR] Range
[COLOR=Royalblue]Dim[/COLOR] x [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]String[/COLOR]

[COLOR=Royalblue]With[/COLOR] Sheets([COLOR=brown]"Make Ready Board"[/COLOR])
    .Range([COLOR=brown]"A1"[/COLOR]).AutoFilter
    x = .Range([COLOR=brown]"E2"[/COLOR]).NumberFormat
    ary = Array(Format([COLOR=Royalblue]Date[/COLOR], x), Format([COLOR=Royalblue]Date[/COLOR] + [COLOR=crimson]1[/COLOR], x), Format([COLOR=Royalblue]Date[/COLOR] + [COLOR=crimson]2[/COLOR], x))
    [COLOR=Royalblue]Set[/COLOR] c = .Range([COLOR=brown]"A1:F"[/COLOR] & .Cells(Rows.Count, [COLOR=brown]"A"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp).Row)
    c.AutoFilter Field:=[COLOR=crimson]5[/COLOR], Criteria1:=ary, [COLOR=Royalblue]Operator[/COLOR]:=xlFilterValues
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]With[/COLOR]

Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]
    [COLOR=Royalblue]With[/COLOR] Sheets([COLOR=brown]"Sheet1"[/COLOR])
        .Cells.Clear
        c.Copy
        [COLOR=Royalblue]With[/COLOR] .Range([COLOR=brown]"A1"[/COLOR])
            .PasteSpecial xlPasteColumnWidths
            .PasteSpecial xlPasteAll, , [COLOR=Royalblue]False[/COLOR], [COLOR=Royalblue]False[/COLOR]
            .PasteSpecial xlPasteFormats, , [COLOR=Royalblue]False[/COLOR], [COLOR=Royalblue]False[/COLOR]
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]With[/COLOR]
        Application.CutCopyMode = [COLOR=Royalblue]False[/COLOR]
        
        .Range([COLOR=brown]"A1"[/COLOR]).CurrentRegion.Sort Key1:=.[E1], Order1:=xlAscending, Header:=xlYes
        
        [COLOR=Royalblue]For[/COLOR] i = UBound(ary) - [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] LBound(ary) [COLOR=Royalblue]Step[/COLOR] -[COLOR=crimson]1[/COLOR]
            [COLOR=Royalblue]Set[/COLOR] c = .Range([COLOR=brown]"A1"[/COLOR]).CurrentRegion.Offset([COLOR=crimson]1[/COLOR]).Columns([COLOR=brown]"E"[/COLOR]).Find(What:=ary(i), LookIn:=xlValues, lookAt:=xlWhole, _
            SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=[COLOR=Royalblue]False[/COLOR], SearchFormat:=[COLOR=Royalblue]False[/COLOR])
            [COLOR=Royalblue]If[/COLOR] [COLOR=Royalblue]Not[/COLOR] c [COLOR=Royalblue]Is[/COLOR] [COLOR=Royalblue]Nothing[/COLOR] [COLOR=Royalblue]Then[/COLOR]
            c.Offset([COLOR=crimson]1[/COLOR]).EntireRow.Insert xlShiftDown
            c.Offset([COLOR=crimson]1[/COLOR]).EntireRow.ClearFormats
            [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
                            
        [COLOR=Royalblue]Next[/COLOR]
    [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]With[/COLOR]
Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR]
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]

https://www.dropbox.com/s/2kus9wg3miz6lri/Today 2.xlsm?dl=0