Excel - Filter - Only keep first date in every month

Jarke

Board Regular
Joined
Aug 13, 2016
Messages
95
Hi all,

Really need some help to avoid some time consuming lame manual filtering. I have 50 different data sets containing three columns each. First data set is in A - Dates, B - Name and C - value.
My data sets have different dates and the quantity of them differs also. But all has the same columns, Dates, Name, Value.

All data sets have daily data, one row per day. I want them in monthly data. My biggest data sets reach back 13 years.

Thus I need to remove all daily data except the first or last value in each month (to be convinient).
My current method involves using the filter and clicking out one date in each month, one at a time. That is around 400-500 clicks for one data set...

The problem with my method is that not every data set has the same dates in a month. So if i want january first for example, some data sets may start in january third. This could be solved with an OR function in a macro, but it's beyond my skills.

What should I do? Is there any macro out there for this?

Thanks alot in advance! Appreciate all help.
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
So, the dates are only for workdays, then, right? If you were looking to sum the amounts in column C by month, you can use a pivot table or a couple helper columns to ID the month and year of each date.

I don't have a macro that loops through a dataset and hides all dates that aren't the first or last date in each month. Have you tried making a macro for this?
 
Upvote 0
Thanks for the input.
Yeah think so. I did it the usual way, created a filter and copyd the set into it, one at a time. Updated it and clicked in the dates that was missing. Not the optimal method as it took an hour or so but it did the trick accurately.
Yes I did, I recorded the filtering, but as the dates varied between the sets it did not autofit. Adding some OR would probably make the trick. A k a first date of month or Second or third, and thus pull out the monthly data.

Still seek for a more optimal method.
 
Upvote 0
I don't believe there is a sleek and easy solution with VBA, but it can be done. An array will be needed to hold all the dates being filtered. It might be best to have another array to hold all the month and year values that it needs to search for.

I think the easier process would be to create month and year columns, sort oldest to newest on the dates column, filter month and year and use keyboard shortcuts to ID the first and last listed date for that month, then cycle to the next month. You can have the macro create the month and year columns, then delete them at the end if you prefer.

In otherwords, the sorting allows us to use the value's position in the filtered data to find if it's the first or last day in the set. If you filtered down to November 2017, the first date listed should be the earliest date, while the last is the latest date. To get the first date, I would use relative referencing in VBA to find it:
Code:
arrDates(i) = Cells(1, 1).Offset(1).Value

The last date in that month would be found with the same tactic:
Code:
arrDates(i + 1) = Cells(1, 1).End(xlDown).Value
 
Upvote 0
How about this
Code:
Sub LastDateCopy()

   Dim Rng As Range
   Dim Cl As Range
   Dim ValU As String
   Dim Itm As Variant
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
         ValU = Month(Cl) & "-" & Year(Cl)
         If Not .exists(ValU) Then
            .Add ValU, Array(Day(Cl), Cl)
         ElseIf Day(Cl) > .Item(ValU)(0) Then
            .Item(ValU) = Array(Day(Cl), Cl)
         End If
      Next Cl
      For Each Itm In .items
         If Rng Is Nothing Then
            Set Rng = Itm(1)
         Else
            Set Rng = Union(Rng, Itm(1))
         End If
      Next Itm
   End With
   Rng.EntireRow.copy Sheets("Master").Range("A2")
End Sub
It will look in col A of the active sheet & copy the last date in each month to a sheet called "Master"
 
Upvote 0
AFPathfinder, thank you for your ideas and feedback, very appreciated!

Fluff, you totally nailed it tho! It was almost exactly what I was looking for. It also seems to be flexible, which is great. So thank you alot!

Are there any drawdowns with the code that I should be aware of?
Would it be possible to find one of the first values instead of the last? It would be more neat with the start of the month.
:)
 
Upvote 0
As long as your dates are always real dates, rather than text that looks like a date, this should always work.
To get the first date try this mod
Code:
ElseIf Day(Cl) [COLOR=#ff0000]<[/COLOR] .Item(ValU)(0) Then
 
Upvote 0
How about this
Code:
Sub LastDateCopy()

   Dim Rng As Range
   Dim Cl As Range
   Dim ValU As String
   Dim Itm As Variant
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
         ValU = Month(Cl) & "-" & Year(Cl)
         If Not .exists(ValU) Then
            .Add ValU, Array(Day(Cl), Cl)
         ElseIf Day(Cl) > .Item(ValU)(0) Then
            .Item(ValU) = Array(Day(Cl), Cl)
         End If
      Next Cl
      For Each Itm In .items
         If Rng Is Nothing Then
            Set Rng = Itm(1)
         Else
            Set Rng = Union(Rng, Itm(1))
         End If
      Next Itm
   End With
   Rng.EntireRow.copy Sheets("Master").Range("A2")
End Sub
It will look in col A of the active sheet & copy the last date in each month to a sheet called "Master"

That is a very slick solution, Fluff! I've never used the "CreateObject("scripting.dictionary")" objects before, but that is a tidy Sub compared to what I was gearing up for. Thanks for posting!
 
Upvote 0
Upvote 0
As long as your dates are always real dates, rather than text that looks like a date, this should always work.
To get the first date try this mod
Code:
ElseIf Day(Cl) [COLOR=#ff0000]<[/COLOR] .Item(ValU)(0) Then

Thank you, it worked like a charm! Terrific work mate.
 
Upvote 0

Forum statistics

Threads
1,213,504
Messages
6,114,016
Members
448,543
Latest member
MartinLarkin

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