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

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
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

D
  • Question Question
Locate first instance of all dates in a column and hide all remaining rows
Replies
4
Views
83
Peter_SSs
Peter_SSs
F
  • Question Question
Changing date format based on fiscal years versus calendar years
Replies
2
Views
188
Peter_SSs
Peter_SSs
S
  • Question Question
Macro to copy and paste special transpose that repeats after each blank row
Replies
3
Views
385
jolivanes
jolivanes
P
  • Solved
Split rows separated by blank row and create multiple files
Replies
8
Views
161
Kaper
Kaper
Sufiyan97
  • Solved
VBA Filter Names from List One by One and then Copy filtered data v2
Replies
6
Views
177
Sufiyan97
Sufiyan97

Forum statistics

Threads
1,223,896
Messages
6,175,263
Members
452,627
Latest member
KitkatToby

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