Checks and Deletions

RWRose

New Member
Joined
Feb 20, 2006
Messages
17
From the example provided below, can someone provide me a method to

1. Delete all rows which contain a date prior to 01/01/04
2. Take the remaining rows in that group and divide the highest price into the lowest price to determine a percentage difference.

This will be extremely helpful since I have up to 40,000 line items + to review and calculate. Each group may vary from 1 to 30 rows.

P/O # Date Qty $
PO931128 08/28/06 10.00 275.00
PO907282 01/18/06 2.00 305.00
PO901818 11/07/05 2.00 305.00
PO880743 04/26/05 3.00 305.00
PO840696 03/18/04 2.00 305.00
PO836648 02/06/04 2.00 305.00
PO826619 09/23/03 1.00 325.00
PO819334 06/05/03 2.00 240.00
PO817487 05/06/03 2.00 240.00

PO931667 09/11/06 38.00 9,260.00
PO927424 07/13/06 16.00 9,500.00
PO881583 04/29/05 150.00 7,150.00

PO916077 03/24/06 189.00 13.00
PO900135 10/19/05 64.00 16.50
PO898440 10/03/05 351.00 13.00
PO871743 03/02/05 234.00 11.94
PO854843 09/15/04 36.00 26.27
PO840212 03/25/04 54.00 19.10
PO822145 07/15/03 63.00 19.10
PO811489 02/27/03 12.00 29.85
PO795329 08/29/02 27.00 26.27

PO918382 04/09/06 38.00 29.25
PO892464 08/09/05 50.00 29.25
PO839531 03/05/04 17.00 30.25
PO822944 07/17/03 26.00 30.25

PO917671 04/10/06 22.00 545.00
PO908392 01/27/06 17.00 545.00
PO903862 11/30/05 15.00 545.00
PO887830 06/24/05 12.00 545.00
PO882613 05/09/05 16.00 545.00
PO824585 08/04/03 55.00 545.00

PO929346 08/08/06 44.00 3,020.99
PO891456 08/01/05 116.00 2,624.26
PO868071 01/18/05 32.00 2,744.04
PO822040 07/03/03 23.00 3,060.00

Thank you for your help and assistance.
 

Some videos you may like

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

Smitty

Legend
Joined
May 15, 2003
Messages
29,536
Does all of your data have those irritating blank rows?

Have you looked at the possibility of using a PivotTable?

With 40k rows, you might want to think about Access though.

Just some thoughts,

Smitty
 

HalfAce

MrExcel MVP
Joined
Apr 6, 2003
Messages
9,453
Hello RWRose,
Short of going with a pivot table or using Access as Smitty suggests, perhaps this will
give you some ideas.
(I recommend trying it out on a considerably smaller data table than 40,000 rows until
you figure out just what you want to do with the percentage differences once they're calculated.) :wink:
Code:
Sub Test()
Dim LstRw As Long, _
    StrtRw As Long, _
    StpRw As Long, _
    HighPrice As Variant, _
    LowPrice As Variant, _
    PercentDiff As Variant
    
ActiveSheet.AutoFilterMode = False
Columns(2).AutoFilter Field:=1, Criteria1:="<1/1/2004"
Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row) _
  .SpecialCells(xlCellTypeVisible).EntireRow.Delete
ActiveSheet.AutoFilterMode = False
    
LstRw = Cells(Rows.Count, "A").End(xlUp).Row
StrtRw = 2

While StrtRw < LstRw
  StpRw = Cells(StrtRw, "A").End(xlDown).Row
  If Cells(StrtRw, "A")(2) = "" Then
    StpRw = StrtRw
    GoTo SkipThisOne
  End If
  HighPrice = WorksheetFunction.Max(Range(Cells(StrtRw, "D"), Cells(StpRw, "D")))
  LowPrice = WorksheetFunction.Min(Range(Cells(StrtRw, "D"), Cells(StpRw, "D")))
  If HighPrice = LowPrice Then
    PercentDiff = "100%"
  Else
    PercentDiff = Format(LowPrice / HighPrice, "##.##%")
  End If
  
  '//Replace this section with whatever you want to do
  MsgBox ("max is " & HighPrice & Chr(10) & _
          "min is " & LowPrice & Chr(10) & _
          "Minimum price is " & PercentDiff & " of the max.")
  '//End of replace section.

SkipThisOne:
  StrtRw = StpRw + 2

Wend
    
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,113,861
Messages
5,544,723
Members
410,630
Latest member
JFORTH97
Top