Separate Dates With Blank, Unformatted Row

J

Justinian

Well-known Member
Joined
Aug 9, 2009
Messages
1,557
Office Version
  1. 365
Platform
  1. Windows
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
​

​
 
Sort by date Sort by votes
Odd. Try this one:

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

[/FONT]
 
Upvote 0

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
The building numbers is col A or B?
Why not just sorting data with that column then delete data that begin with 32 or below?
 
Upvote 0
The building numbers are in column A.

I could do that but wanted code to do that for me. I recorded a macro doing just that but it is static and not dynamic:

Sub Macro1()


Range("A2:F2").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.Worksheets("Make Ready Board").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Make Ready Board").Sort.SortFields.Add2 Key:=Range _
("A2:A88"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Make Ready Board").Sort
.SetRange Range("A2:F88")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Rows("2:31").Select
Selection.Delete Shift:=xlUp
Range("A2:F2").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.Worksheets("Make Ready Board").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Make Ready Board").Sort.SortFields.Add2 Key:=Range _
("E2:E58"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Make Ready Board").Sort
.SetRange Range("A2:F58")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
End Sub
 
Last edited:
Upvote 0
Ok, try this:

Code: 
[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1109941c()
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] va

Sheets([COLOR=brown]"Make Ready Board"[/COLOR]).Activate

[COLOR=Royalblue]With[/COLOR] Range([COLOR=brown]"A1:F"[/COLOR] & Cells(Rows.count, [COLOR=brown]"A"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp).Row)

    .Sort Key1:=[A1], Order1:=xlAscending, Header:=xlYes
        va = .Value
        
        [COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])
             [COLOR=Royalblue]If[/COLOR] [COLOR=Royalblue]CStr[/COLOR](Left(va(i, [COLOR=crimson]1[/COLOR]), [COLOR=crimson]2[/COLOR])) >= [COLOR=brown]"33"[/COLOR] [COLOR=Royalblue]Then[/COLOR] [COLOR=Royalblue]Exit[/COLOR] [COLOR=Royalblue]For[/COLOR]
        [COLOR=Royalblue]Next[/COLOR]
    
        [COLOR=Royalblue]If[/COLOR] i > [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]Then[/COLOR]
            Rows([COLOR=brown]"2:"[/COLOR] & i - [COLOR=crimson]1[/COLOR]).Delete
            [COLOR=Royalblue]Else[/COLOR]
            MsgBox [COLOR=brown]"Can't find Unit with number below 33xx"[/COLOR]
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
        
    .Sort Key1:=[E1], Order1:=xlAscending, Header:=xlYes

[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]With[/COLOR]

[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]
 
Upvote 0
You're welcome, glad to help, & thanks for the feedback.:)
 
Upvote 0
Akuini said:
Ok, try this:

Code: 
[FONT=lucida console][COLOR=royalblue]Sub[/COLOR] a1109941c()
[COLOR=royalblue]Dim[/COLOR] i [COLOR=royalblue]As[/COLOR] [COLOR=royalblue]Long[/COLOR]
[COLOR=royalblue]Dim[/COLOR] va

Sheets([COLOR=brown]"Make Ready Board"[/COLOR]).Activate

[COLOR=royalblue]With[/COLOR] Range([COLOR=brown]"A1:F"[/COLOR] & Cells(Rows.count, [COLOR=brown]"A"[/COLOR]).[COLOR=royalblue]End[/COLOR](xlUp).Row)

    .Sort Key1:=[A1], Order1:=xlAscending, Header:=xlYes
        va = .Value
        
        [COLOR=royalblue]For[/COLOR] i = [COLOR=crimson]2[/COLOR] [COLOR=royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])
             [COLOR=royalblue]If[/COLOR] [COLOR=royalblue]CStr[/COLOR](Left(va(i, [COLOR=crimson]1[/COLOR]), [COLOR=crimson]2[/COLOR])) >= [COLOR=brown]"33"[/COLOR] [COLOR=royalblue]Then[/COLOR] [COLOR=royalblue]Exit[/COLOR] [COLOR=royalblue]For[/COLOR]
        [COLOR=royalblue]Next[/COLOR]
    
        [COLOR=royalblue]If[/COLOR] i > [COLOR=crimson]2[/COLOR] [COLOR=royalblue]Then[/COLOR]
            Rows([COLOR=brown]"2:"[/COLOR] & i - [COLOR=crimson]1[/COLOR]).Delete
            [COLOR=royalblue]Else[/COLOR]
            MsgBox [COLOR=brown]"Can't find Unit with number below 33xx"[/COLOR]
        [COLOR=royalblue]End[/COLOR] [COLOR=royalblue]If[/COLOR]
        
    .Sort Key1:=[E1], Order1:=xlAscending, Header:=xlYes

[COLOR=royalblue]End[/COLOR] [COLOR=royalblue]With[/COLOR]

[COLOR=royalblue]End[/COLOR] [COLOR=royalblue]Sub[/COLOR][/FONT]
Click to expand...

How can this code be adjusted so that the dates start with today? For example, when I run the code, it should remove any rows that have a date occurring prior to today's date.
 
Upvote 0
Justinian said:
How can this code be adjusted so that the dates start with today? For example, when I run the code, it should remove any rows that have a date occurring prior to today's date.
Click to expand...

So the criteria are:
1. all building numbers that begin with 32 or below are removed.
2. all dates (in col E) prior to today's date are removed.

Try this:

Code: 
[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1109941e()
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], n [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] va, fm

Sheets([COLOR=brown]"Make Ready Board"[/COLOR]).Activate
n = Cells(Rows.Count, [COLOR=brown]"A"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp).Row
[COLOR=Royalblue]With[/COLOR] Range([COLOR=brown]"A1:F"[/COLOR] & n)
       
    .Sort Key1:=[A1], Order1:=xlAscending, Header:=xlYes

        va = .Value

        [COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]To[/COLOR] n
             [COLOR=Royalblue]If[/COLOR] [COLOR=Royalblue]CStr[/COLOR](Left(va(i, [COLOR=crimson]1[/COLOR]), [COLOR=crimson]2[/COLOR])) >= [COLOR=brown]"33"[/COLOR] [COLOR=Royalblue]Then[/COLOR] [COLOR=Royalblue]Exit[/COLOR] [COLOR=Royalblue]For[/COLOR]
        [COLOR=Royalblue]Next[/COLOR]

        [COLOR=Royalblue]If[/COLOR] i > [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]Then[/COLOR]
            Rows([COLOR=brown]"2:"[/COLOR] & i - [COLOR=crimson]1[/COLOR]).Delete
            [COLOR=Royalblue]Else[/COLOR]
            MsgBox [COLOR=brown]"Can't find Unit with number below 33xx"[/COLOR]
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]

    .Sort Key1:=[E1], Order1:=xlAscending, Header:=xlYes
    
    fm = Application.Match([COLOR=Royalblue]CLng[/COLOR]([COLOR=Royalblue]CDate[/COLOR]([COLOR=Royalblue]Date[/COLOR])), Range([COLOR=brown]"E1:E"[/COLOR] & n), [COLOR=crimson]0[/COLOR])
        
        [COLOR=Royalblue]If[/COLOR] IsNumeric(fm) [COLOR=Royalblue]Then[/COLOR]
            
            [COLOR=Royalblue]If[/COLOR] fm > [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]Then[/COLOR] Rows([COLOR=brown]"2:"[/COLOR] & fm - [COLOR=crimson]1[/COLOR]).Delete
        
        [COLOR=Royalblue]Else[/COLOR]
            
            fm = Application.Match([COLOR=Royalblue]CLng[/COLOR]([COLOR=Royalblue]CDate[/COLOR]([COLOR=Royalblue]Date[/COLOR])), Range([COLOR=brown]"E1:E"[/COLOR] & n), [COLOR=crimson]1[/COLOR])
                [COLOR=Royalblue]If[/COLOR] IsNumeric(fm) [COLOR=Royalblue]Then[/COLOR] Rows([COLOR=brown]"2:"[/COLOR] & fm).Delete
        
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]


[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]With[/COLOR]

[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]
 
Upvote 0
Thank you so much! I am sorry my boss keeps changing his thoughts on this but you have been very helpful and I appreciate your time.
 
Upvote 0
You're welcome, glad to help, & thanks for the feedback.:)
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
large/complicated =(Sort(Unique)) or similar
Replies
1
Views
133
KRice
K
B
  • Question
VBA to show and change list of names depending on selection
Replies
7
Views
452
mumps
mumps
N
  • Locked
  • Question
Exccel - date formula that drives multiple other formulas
Replies
2
Views
109
Fluff
Fluff
P
  • Solved
Tough Data Sheet to get Login/Login dates and times.
Replies
7
Views
321
Fluff
Fluff
N
  • Question
Marco, IFS and XLOOKUP but certainly happy to be wrong
Replies
2
Views
121
N0t Y0urs
N

Forum statistics

Threads
1,214,525
Messages
6,120,051
Members
448,940
Latest member
mdusw

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top