Select Max Value for ID

F

Forestq

Active Member
Joined
May 9, 2010
Messages
482
Team,
I need to write macro, which will be sorting two columns:

- first is ID (ID could be this some like here):
120
120
120
131
131
132
140
140
...
..
.

- second is status: Published or draft, and then

- from third columns (due date) select the max data for ID:

***example (columns with simple data)***
ID ---------- status -------------due date
120 -------- Published -------- 31-Dec-2008
120 -------- Published -------- 11-Sep-2011
120 -------- draft -------------01-Jan-2010
131 -------- Published -------- 08-Sep-2011
131 -------- Published -------- 14-Dec-2011

result should be:
120 - 11-Sep-2011
131 - 14-Dec-2011
All results should be paste in sheet2.

I just now how sort data:
Code: 
  ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
 
  ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
        ("A2:A2800"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
 
  ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
        ("E2:E2800"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
 
  With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
  End With


Please help me with this case.

regards,
PvK
 
Sort by date Sort by votes
When I have this code

Code: 
    Dim r As Range
    Dim lastRow As Integer
    Set r = Range("P2")
    lastRow = r.End(xlDown).Row
 
    Range("K:K").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("O1" _
        ), unique:=True
    Range("P1") = "Date"
    With Range("P2")
        .FormulaArray = "=MAX(IF(K:K=O2,L:L))"
        .AutoFill Destination:=Range("P2:P" + CStr(lastRow))
    End With
    Range("P2:P" + CStr(lastRow)).NumberFormat = "dd/mm/yyyy"



I have error:

Code: 
lastRow = r.End(xlDown).Row

.....Why??
 
Upvote 0

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Little changes and works cool, for all concerned...
Code: 
    Dim r As Range
    Dim lastRow As Integer
    Set r = Range("O1")
 
    Range("K:K").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("O1" _
        ), unique:=True
 
    lastRow = r.End(xlDown).Row
 
    Range("P1") = "Date"
    With Range("P2")
        .FormulaArray = "=MAX(IF(K:K=O2,L:L))"
        .AutoFill Destination:=Range("P2:P" + CStr(lastRow))
    End With
    Range("P2:P" + CStr(lastRow)).NumberFormat = "dd/mm/yyyy"

regards,
PvK
 
Upvote 0
It's necessary to add this code
Code: 
    ActiveWorkbook.Worksheets("test AA z sortem").Sort.SortFields.Add Key:=Range("O:O" _
       ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

that sorting by "lAscending" would be correct?

Code: 
Sub mcrListAA_SORT()
 Dim r As Range
    Dim lastRow As Integer
    Set r = Range("O1")
 
    Range("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("O1" _
        ), unique:=True
 
  '  ActiveWorkbook.Worksheets("test AA z sortem").Sort.SortFields.Add Key:=Range("O:O" _
  '     ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
 
    With ActiveWorkbook.Worksheets("test AA z sortem").Sort
      .SetRange Range("O:O")
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
 
    lastRow = r.End(xlDown).Row
 
    Range("P1") = "Date"
    With Range("P2")
        .FormulaArray = "=MAX(IF(A:A=O2,G:G))"
        .AutoFill Destination:=Range("P2:P" + CStr(lastRow))
    End With
    Range("P2:P" + CStr(lastRow)).NumberFormat = "dd/mm/yyyy"
End Sub

Now, when I have this code mark with comment ( ' ), I think it's work ok, but I'm not sure, that should be like this....

PvK
 
Upvote 0
Object not set

Hi,

I am facing difficulty to run this VBA code....

When i run this code it works fine for me but after close excel sheet I tried again to generate excel, It gives me Object not set type error on short.clear line....

Kindly help us...

Set objExcel = CreateObject("Excel.Application")
sExcelFilePath = "C:\spil_andon\line pausel_report.xls"
objExcel.Workbooks.Open (sExcelFilePath)
objExcel.Application.Visible = True
objExcel.Application.WindowState = -4137
objExcel.Application.ActiveWindow.WindowState = -4137 '-4137=xlMaximized
sHeight = objExcel.Height

With objExcel

.Cells(4, 1).Value = DTPicker1.Value
.Cells(4, 2).Value = DTPicker2.Value
.Cells(4, 3).Value = ComboBox1.Text
End With

ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add key:=Range("B8:B39") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A7:C39")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

ActiveWindow.SmallScroll Down:=42
Range("A44:C62").Select
ActiveWindow.SmallScroll Down:=9
Range("C62:C63").Select
ActiveWindow.SmallScroll Down:=-9
Range("A43:C75").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add key:=Range("C44:C75") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A43:C75")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
 
Upvote 0
Re: Object not set

Excuse me for asking but I don't see how this message has anything to do with the original thread?
/p

tsci said:
Hi,

I am facing difficulty to run this VBA code....

When i run this code it works fine for me but after close excel sheet I tried again to generate excel, It gives me Object not set type error on short.clear line....

Kindly help us...

Set objExcel = CreateObject("Excel.Application")
sExcelFilePath = "C:\spil_andon\line pausel_report.xls"
objExcel.Workbooks.Open (sExcelFilePath)
objExcel.Application.Visible = True
objExcel.Application.WindowState = -4137
objExcel.Application.ActiveWindow.WindowState = -4137 '-4137=xlMaximized
sHeight = objExcel.Height

With objExcel

.Cells(4, 1).Value = DTPicker1.Value
.Cells(4, 2).Value = DTPicker2.Value
.Cells(4, 3).Value = ComboBox1.Text
End With

ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add key:=Range("B8:B39") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A7:C39")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

ActiveWindow.SmallScroll Down:=42
Range("A44:C62").Select
ActiveWindow.SmallScroll Down:=9
Range("C62:C63").Select
ActiveWindow.SmallScroll Down:=-9
Range("A43:C75").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add key:=Range("C44:C75") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A43:C75")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Macro to select column to run 'sort by colours' macro on
Replies
3
Views
284
Joe4
Joe4
G
  • Question Question
Sort (Z-A) Macro not working
Replies
1
Views
84
NateSC
NateSC
J
  • Question Question
Rename a Sheet
Replies
2
Views
368
Peter_SSs
Peter_SSs
G
  • Solved
Filter columns (number of rows keeps changing)
Replies
1
Views
331
myall_blues
myall_blues
G
  • Solved
Typing out Excel formula in Excel Macro
Replies
1
Views
70
Macropod
Macropod

Forum statistics

Threads
1,224,507
Messages
6,179,183
Members
452,893
Latest member
denay

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