View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
joel joel is offline
external usenet poster
 
Posts: 9,101
Default Multiple Column Criteria which deletes all but Highest Value

There is a small problem with both my code and JLathem code that when an
employee has the same number of hours on two rows the code will leave both
rows. i think you only want one row left. Make this change in my code

from
"=IF(AND(A2=A3,E2=E3,G2=G3,H2H3),""X"","""")"
to
"=IF(AND(A2=A3,E2=E3,G2=G3,H2=H3),""X"","""") "

"Joel" wrote:

I had to sort on 4 columns (A, E, G, H). so I did 2 sorts. I sorted H in
descending order then put this formula in row 3. Row 3 will alway contain
the highest number of hours for the 1st employee since I sorted H in
descending order.

place in column IV the last column
"=IF(AND(A2=A3,E2=E3,G2=G3,H2H3),""X"","""")"

The formula puts an X in the rows where the hours for the same employee
(paycode, pay period) is the same but the hours are less. Then I sort on
Column IV to bring the X's to the top of the worksheet. I then delete the
rows with the X's.

It is a slow process in excel to delete rows 1 at a time. It is much
quicker especially if you have a large number of rows to sort and do 1
delete. I have had files with 5,000 rows and the delete took a couple of
minues. This code will always work in a couple of seconds.



Sub DeleteRows()

'get Last Row of file
Lastrow = Range("A" & Rows.Count).End(xlUp).Row

'sort on 4 criteria so you ned to do 2 sorts
'first sort on Hours in decreasing time
'column H = Hours
Rows("1:" & Lastrow).Sort _
header:=xlYes, _
key1:=Range("H1"), _
order1:=xlDescending

'now sort on other columns
'column A employee
'column E Pay code
'column G pay period
Rows("1:" & Lastrow).Sort _
header:=xlYes, _
key1:=Range("A1"), _
order1:=xlAscending, _
key2:=Range("E1"), _
order2:=xlAscending, _
key3:=Range("G1"), _
order3:=xlAscending

'place x in column IV using a formula to indicate
'which lines to delete
'row 2 will never get deleted since it will alway be the highest # hours
Range("IV3").Formula = _
"=IF(AND(A2=A3,E2=E3,G2=G3,H2H3),""X"","""")"
'copy formula down the column
Range("IV3").Copy _
Destination:=Range("IV3:IV" & Lastrow)

'replace formula with values
Range("IV3:IV" & Lastrow).Copy
Range("IV3:IV" & Lastrow).PasteSpecial _
Paste:=xlPasteValues

Rows("1:" & Lastrow).Sort _
header:=xlYes, _
key1:=Range("IV1"), _
order1:=xlDescending

'find last X
Set c = Columns("IV").Find(what:="X", _
LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlPrevious)

'delete rows
If Not c Is Nothing Then
Lastrow = c.Row
Rows("2:" & Lastrow).Delete
End If

'delete column IV
Columns("IV").Delete

End Sub


"ShagNasty" wrote:

Sorry if in wrong Discussion group...

Spreadsheet with columns A thru K -- columns A, E, G, & J have employee data
(name, pay code, pay period, and hours respectively). Frequent pay
adjustments are made to many employees time during a given pay period. I
need to delete all records (rows), but the highest hour total, for the
employee, pay code, and pay period. MS Office SP3, Win XP, Approx 20k rows.

EmpName ENum JCode JDesc PayCode PDesc PayPeriod Hours
Emp A 0000A ABC ABC 055 OT 01/25/09 5
Emp A 0000A ABC ABC 055 OT 01/25/09 7.5
Emp A 0000A ABC ABC 065 ST 01/25/09 8
Emp A 0000A ABC ABC 065 ST 01/25/09 4
Emp B 0000B NBC NBC 055 OT 02/25/09 3
Emp B 0000B NBCN NBC 055 OT 02/25/09 5
Emp B 0000B NBC NBC 055 OT 02/25/09 16

I need to retain rows 3 (7.5), 4 (8), and 8 (16)

Thanks.. ShagNasty