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
​

​

 

[Justinian]

Never mind, I got it working now. Thw auto filter was throwing off my data import.

Thank you!

 

[Akuini]

You're welcome, glad to help, & thanks for the feedback.

 

[Justinian]

I spoke too soon. When I run this report today, I should get results for 9/19, 9/20, and 9/22 but instead, I only get result for 9/19 and 9/20:

https://app.box.com/s/64rd7i85omis3v1hcsp9impr2dkothi2

 

[Akuini]

I spoke too soon. When I run this report today, I should get results for 9/19, 9/20, and 9/22 but instead, I only get result for 9/19 and 9/20:

So if there's no 9/21 then you want to pick 9/22?

if today is 9/16/19, I need the spreadsheet to only show 9/16, 9/17, and 9/18,

In your criteria (in post 1) you didn't mention if there's empty date in the 3 dates then we should pick any following date, is that what you want?

 

[Justinian]

Sorry if I was unclear in my first post. The code should always yield today and the next two days (3 days total), whether they are weekends or not.

Yes, if there is no 9/21, it should jump to the next date in the data set.

 

[Akuini]

Ok, try this:
The data must be sorted ascending by col E when you run the code.

[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] Clip_Data1()

[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, d [COLOR=Royalblue]As[/COLOR] Range, e [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
[COLOR=Royalblue]Set[/COLOR] c = Range([COLOR=brown]"E:E"[/COLOR]).Find(What:=Format([COLOR=Royalblue]Date[/COLOR], x), LookIn:=xlValues, lookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=[COLOR=Royalblue]False[/COLOR], SearchFormat:=[COLOR=Royalblue]False[/COLOR])

[COLOR=Royalblue]Set[/COLOR] d = Range([COLOR=brown]"E:E"[/COLOR]).Find(What:=Format(c.Offset([COLOR=crimson]1[/COLOR]), x), LookIn:=xlValues, lookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=[COLOR=Royalblue]False[/COLOR], SearchFormat:=[COLOR=Royalblue]False[/COLOR])

[COLOR=Royalblue]Set[/COLOR] e = Range([COLOR=brown]"E:E"[/COLOR]).Find(What:=Format(d.Offset([COLOR=crimson]1[/COLOR]), x), LookIn:=xlValues, lookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=[COLOR=Royalblue]False[/COLOR], SearchFormat:=[COLOR=Royalblue]False[/COLOR])

ary = Array(Format(c, x), Format(d, x), Format(e, 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
    
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]

 

[Justinian]

Ok, perfect.

Thank you again!

 

[Akuini]

You're welcome, again.

 

[Justinian]

Sorry to bother you again but today, my boss decided to change this report. I have attached the report I ran this morning without applying any filters or formatting. How can I write code so that all building numbers that begin with 32 or below are removed, leaving only buildings that begin with 33 through 50?

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

[/FONT]

 

[Akuini]

I can't download the file.
"This shared file or folder link has been removed or is unavailable to you."