Excel - Filter - Only keep first date in every month

[Jarke]

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.

 

[Fluff]

Glad to help & thanks for the feedback

 

[foranpower]

How could it be possible to use this for extracting the last/first day of each year instead of each month? I tried replacing Month(Cl) with Day(Cl), but that didn't seem to work.

How about this

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"

 

[Fluff]

In what way "didn't it work"?

 

[foranpower]

Specifically, it prints months 1,2, and 4 of each year. My goal is only the first trading price of gold in January.

Thanks to your code, it was a breeze to get gold's trading price at the start and the end of each month.

Your code: ValU = Month(Cl) & "-" & Year(Cl)
I replaced it with: ValU = Day(Cl) & "-" & Year(Cl)
As mentioned, this causes only the values for months 1,2, and 4 to be printed.

If you don't mind me scrounging your code, what am I missing to take only takes the value from the first month of each year?

 

[Fluff]

Try it like

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))
         If Not .exists(Year(Cl)) Then
            .Add Year(Cl), Array(Cl.Value, Cl)
         ElseIf Cl.Value < .Item(Year(Cl))(0) Then
            .Item(Year(Cl)) = Array(Cl.Value, 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

 

[foranpower]

This is beautiful!

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))
         If Not .exists(Year(Cl)) Then
            .Add Year(Cl), Array(Cl.Value, Cl)
         ElseIf Cl.Value < .Item(Year(Cl))(0) Then
            .Item(Year(Cl)) = Array(Cl.Value, 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

 

[Fluff]

You're welcome & thanks for the feedback