MAx Date multiple criteria

N

nahmja

New Member
Joined
May 12, 2015
Messages
15
Hi I am looking for some one help..my data is as below.

[TABLE="width: 425"]
<colgroup><col><col><col><col><col></colgroup><tbody>[TR]
[TD]DATE[/TD]
[TD]Dept[/TD]
[TD]BRANCH[/TD]
[TD]Transaction[/TD]
[TD]Terminal ID[/TD]
[/TR]
[TR]
[TD]8-Oct-15[/TD]
[TD]TT[/TD]
[TD]MCT[/TD]
[TD]IN[/TD]
[TD]21666446[/TD]
[/TR]
[TR]
[TD]8-Oct-15[/TD]
[TD]TT[/TD]
[TD]NIZ[/TD]
[TD]OUT[/TD]
[TD]21666434[/TD]
[/TR]
[TR]
[TD]8-Oct-14[/TD]
[TD]TT[/TD]
[TD]MCT[/TD]
[TD]OUT[/TD]
[TD]21666446[/TD]
[/TR]
[TR]
[TD]26-Mar-11[/TD]
[TD]TT[/TD]
[TD]MCT[/TD]
[TD]OUT[/TD]
[TD]21666760[/TD]
[/TR]
[TR]
[TD]26-Mar-11[/TD]
[TD]TT[/TD]
[TD]MCT[/TD]
[TD]OUT[/TD]
[TD]24600600[/TD]
[/TR]
[TR]
[TD]27-Mar-14[/TD]
[TD]TT[/TD]
[TD]MCT[/TD]
[TD]OUT[/TD]
[TD]24600600[/TD]
[/TR]
[TR]
[TD]27-Mar-11[/TD]
[TD]TT[/TD]
[TD]MCT[/TD]
[TD]IN[/TD]
[TD]21666471[/TD]
[/TR]
</tbody>[/TABLE]

Required result would be as below.

[TABLE="width: 425"]
<colgroup><col><col><col><col><col></colgroup><tbody>[TR]
[TD]DATE[/TD]
[TD]Dept[/TD]
[TD]BRANCH[/TD]
[TD]Transaction[/TD]
[TD]Terminal ID[/TD]
[/TR]
[TR]
[TD]8-Oct-15[/TD]
[TD]TT[/TD]
[TD]NIZ[/TD]
[TD]OUT[/TD]
[TD]21666434[/TD]
[/TR]
[TR]
[TD]8-Oct-15[/TD]
[TD]TT[/TD]
[TD]MCT[/TD]
[TD]IN[/TD]
[TD]21666446[/TD]
[/TR]
[TR]
[TD]27-Mar-14[/TD]
[TD]TT[/TD]
[TD]MCT[/TD]
[TD]OUT[/TD]
[TD]24600600[/TD]
[/TR]
[TR]
[TD]27-Mar-11[/TD]
[TD]TT[/TD]
[TD]MCT[/TD]
[TD]IN[/TD]
[TD]21666471[/TD]
[/TR]
[TR]
[TD]26-Mar-11[/TD]
[TD]TT[/TD]
[TD]MCT[/TD]
[TD]OUT[/TD]
[TD]21666760[/TD]
[/TR]
</tbody>[/TABLE]
 
Sort by date Sort by votes
Try this:-
Results start "H1".
Code: 
[COLOR="Navy"]Sub[/COLOR] MG08Oct24
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Ray = ActiveSheet.Range("A1").CurrentRegion
ReDim nray(1 To UBound(Ray, 1), 1 To UBound(Ray, 2))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] Rw = 1 To UBound(Ray, 1)
[COLOR="Navy"]If[/COLOR] Not .Exists(Ray(Rw, 5)) [COLOR="Navy"]Then[/COLOR]
n = n + 1
    [COLOR="Navy"]For[/COLOR] Ac = 1 To 5
        nray(n, Ac) = Ray(Rw, Ac)
    [COLOR="Navy"]Next[/COLOR] Ac
.Add Ray(Rw, 5), n
[COLOR="Navy"]Else[/COLOR]
    [COLOR="Navy"]If[/COLOR] Ray(Rw, 1) > nray(.Item(Ray(Rw, 5)), 1) [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]For[/COLOR] Ac = 1 To 5
            nray(.Item(Ray(Rw, 5)), Ac) = Ray(Rw, Ac)
        [COLOR="Navy"]Next[/COLOR] Ac
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Rw


[COLOR="Navy"]With[/COLOR] Range("H1").Resize(n, 5)
    .Value = nray
    .Columns.AutoFit
    .Borders.Weight = 2
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Thanks Mick,

your quick response, basically i have two suppurate files, how i can use this ?
 
Upvote 0
Do you mean 2 separate Workbooks , and you want the results in the seconds workbook or 2 separate sheets and you want the results on a separate sheet.
 
Upvote 0
Try this chunk of code also. Slightly edited from macro recorder code. Remember to backup your data before attempting this

Code: 
Sub SortRemoveDup()
    ' Figure out the current last row with data assuming num of columns dont change
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    ' Sort by date newest to oldest "AND THEN" by Terminal ID smallest to largest
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1:A" & LastRow), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1:A" & LastRow), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
    ' Remove duplicates based on Terminal ID
    ActiveSheet.Range("$A$1:$E$" & LastRow).RemoveDuplicates Columns:=5, Header:=xlYes
End Sub
 
Last edited:
Upvote 0
mathematician said:
Try this chunk of code also. Slightly edited from macro recorder code. Remember to backup your data before attempting this

Code: 
Sub SortRemoveDup()
    ' Figure out the current last row with data assuming num of columns dont change
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    ' Sort by date newest to oldest "AND THEN" by Terminal ID smallest to largest
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1:A" & LastRow), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1:A" & LastRow), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
    ' Remove duplicates based on Terminal ID
    ActiveSheet.Range("$A$1:$E$" & LastRow).RemoveDuplicates Columns:=5, Header:=xlYes
End Sub
Click to expand...
Ignore this and use the one below
Code: 
Sub SortRemoveDup()
    ' Figure out the current last row with data assuming num of columns dont change
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row


    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    
    ' Sort by date newest to oldest "AND THEN" by Terminal ID smallest to largest
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("$A$1:$A$" & LastRow), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("$E$1:$E$" & LastRow), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:E" & LastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ' Remove duplicates based on Terminal ID
    ActiveSheet.Range("$A$1:$E$" & LastRow).RemoveDuplicates Columns:=5, Header:=xlYes


End Sub
 
Upvote 0
Run the Code within the Data Workbook/Data sheet ensuring the Second WorkBook is Open.
Change WKbook details as shown in code.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG11Oct56
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Ray = ActiveSheet.Range("A1").CurrentRegion
ReDim nray(1 To UBound(Ray, 1), 1 To UBound(Ray, 2))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] Rw = 1 To UBound(Ray, 1)
[COLOR="Navy"]If[/COLOR] Not .Exists(Ray(Rw, 5)) [COLOR="Navy"]Then[/COLOR]
n = n + 1
    [COLOR="Navy"]For[/COLOR] Ac = 1 To 5
        nray(n, Ac) = Ray(Rw, Ac)
    [COLOR="Navy"]Next[/COLOR] Ac
.Add Ray(Rw, 5), n
[COLOR="Navy"]Else[/COLOR]
    [COLOR="Navy"]If[/COLOR] Ray(Rw, 1) > nray(.Item(Ray(Rw, 5)), 1) [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]For[/COLOR] Ac = 1 To 5
            nray(.Item(Ray(Rw, 5)), Ac) = Ray(Rw, Ac)
        [COLOR="Navy"]Next[/COLOR] Ac
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Rw


'[COLOR="Green"][B]Change workbook Details to suit in line below[/B][/COLOR]
[COLOR="Navy"]With[/COLOR] Workbooks("Second_Wkbk.xlsm").Sheets("Sheet1").Range("A1").Resize(n, 5)
    .Value = nray
    .Columns.AutoFit
    .Borders.Weight = 2
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Locked
  • Question Question
Exccel - date formula that drives multiple other formulas
Replies
2
Views
465
Fluff
Fluff
M
  • Question Question
Index Match function List based on date
Replies
7
Views
421
Fluff
Fluff
J
  • Solved
Return multiple dates if coulmn header meets values in another cell
Replies
3
Views
424
Alex Blakenburg
A
E
  • Solved
Formula not working
Replies
2
Views
376
esmarques
E
F
  • Solved
Formula determine if a date falls between a specific M/D range for multiple years for YTD comparison.
Replies
6
Views
983
flashgordie
F

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