View Full Version : [SOLVED:] Get All Most Recent Dates per Month in a Single Column VBA
jazz2409
05-08-2020, 02:18 AM
Hello, is there another way to get all the most recent dates per month that are in a single column? I am currently using a Pivot Table to do this but if there's a shorter way to do this, I want that :D
Sub GetDates()
Dim rawSh As Worksheet
Dim dncSh As Worksheet
Set rawSh = Worksheets("raw")
Set dncSh = Worksheets("Database")
Set PC = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rawSh.Range("A1").CurrentRegion)
Set pt = PC.CreatePivotTable(TableDestination:=rawSh.Range("R1"))
With pt
.ColumnGrand = False
.RowGrand = False
With .PivotFields("DateOfData")
.Orientation = xlRowField
.Position = 1
.AutoGroup
End With
.AddDataField .PivotFields("DateOfData"), "Count of DateOfData", xlCount
With .PivotFields("Count of DateOfData")
.Caption = "Max of DateOfData"
.Function = xlMax
.NumberFormat = "[$-en-US]d-mmm;@"
End With
End With 'pt
End Sub
Any help is appreciated. Thank you :)
jazz2409
05-09-2020, 05:31 AM
Anyone?
paulked
05-09-2020, 05:47 AM
I think you need to post a workbook of example data
jazz2409
05-09-2020, 06:14 AM
Sorry :omg2:
paulked
05-09-2020, 06:30 AM
:what: That's just a list of dates!!!!
jazz2409
05-09-2020, 06:33 AM
Hmmm I only need to get the max dates per month based on that list.. Am I missing something? :(
paulked
05-09-2020, 12:34 PM
Sub GetDates()
Dim ar(), ar1(), ar2(), i&, j&, k&, lr&, yH&, yL&, x&, y&, tm#
tm = Timer
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(3).Row
ReDim ar(1 To 1, 1 To lr - 1)
ReDim ar1(1 To 3, 1 To 1)
x = 1
Range("a2:a" & lr).Copy Range("Z2")
Range("z2:z" & lr).Sort Range("z2:z" & lr), xlDescending
Range("aa2:aa" & lr) = "=TEXT(RC[-1],""dd/mm/yyyy"")"
ar = Range("aa2:aa" & lr)
yH = Val(Right(ar(LBound(ar), 1), 4))
yL = Val(Right(ar(UBound(ar), 1), 4))
For i = yL To yH
For j = 1 To 12
For k = 1 To lr - 1
If Val(Right(ar(k, 1), 4)) = i And Val(Mid(ar(k, 1), 4, 2)) = j Then
If Val(Left(ar(k, 1), 2)) > ar1(1, x) Then
ar1(1, x) = Val(Left(ar(k, 1), 2))
ar1(2, x) = j
ar1(3, x) = i
y = 1
End If
End If
Next
If y = 1 Then
x = x + 1
ReDim Preserve ar1(1 To 3, 1 To x)
y = 0
End If
Next
Next
For i = 1 To x - 1
ReDim Preserve ar2(1 To 1, 1 To i)
ar2(1, i) = ar1(2, i) & "/" & ar1(1, i) & "/" & ar1(3, i)
Next
Range("z2:aa" & lr) = ""
lr = Cells(Rows.Count, 3).End(xlUp).Row
Range("c2:c" & lr).ClearContents
Range("c2:c" & i).NumberFormat = "[$-en-US]dd-mmm-yy;@"
Range("c2:c" & i) = WorksheetFunction.Transpose(ar2)
Debug.Print Timer - tm
End Sub
This isn't as fast as the pt (0.5secs v 0.3 secs) but it works with different years.
jazz2409
05-09-2020, 07:59 PM
Hi Paul, this is exactly what I needed! :clap:
Thank you! :bow:
paulked
05-09-2020, 08:03 PM
You're welcome :thumb
I'd prefer:
Sub M_snb()
sn = Sheet1.Columns(1).SpecialCells(2)
With CreateObject("scripting.dictionary")
For j = 2 To UBound(sn)
.Item(sn(j, 1)) = .Item(sn(j, 1)) + 1
Next
ReDim st(11, 1)
For Each it In .keys
If .Item(it) > st(Month(it) -1, 0) Then
st(Month(it) -1, 0) = .Item(it)
st(Month(it) -1, 1) = it
End If
Next
End With
Sheet1.Cells(2, 3).Resize(12, 2) = st
End Sub
paulked
05-10-2020, 05:57 AM
Like the idea of the dictionary, but it gave me the wrong dates.
160
6-Mar-20
141
3-Apr-20
65
1-May-20
Which dates do you prefer ?
Not arrayformula?
=MAX((MONTH($A$2:$A$8000)=3)*$A$2:$A$8000)
Paul_Hossler
05-10-2020, 07:42 AM
FWIW, I had to use the OP's macro to make the PT to see exactly how they were defining 'most recent dates'
26620
paulked
05-10-2020, 07:55 AM
Yes, a bit confusing at first which is why I asked for a workbook.
In that case these formulae suffice:
=MAX((MONTH($A$2:$A$8000)=3)*$A$2:$A$8000)
=MAX((MONTH($A$2:$A$8000)=4)*$A$2:$A$8000)
=MAX((MONTH($A$2:$A$8000)=5)*$A$2:$A$8000)
Paul_Hossler
05-10-2020, 09:02 AM
In that case these formulae suffice:
=MAX((MONTH($A$2:$A$8000)=3)*$A$2:$A$8000)
=MAX((MONTH($A$2:$A$8000)=4)*$A$2:$A$8000)
=MAX((MONTH($A$2:$A$8000)=5)*$A$2:$A$8000)
Yes, for the data set given, but what happens when June rolls around, or someone adds January, or there's 2019 or 2021 data?
The TS didn't mention, nor some 10000 other unlikely events.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.