[b]Problem in Filtering Huge[/b] Data (Urgent)

[smartbuilder2k]

Hi All,

I have got 3 columns, namely - A) DefectNo B)Fixed/SendBackDate C)Action_name.

-> The "DefectNo." column may contain duplicate values. For ex: "Def100" has occured several times but with different Fixed/SendBackDate & Action_name.

->The "Fixed/sendbackDate" column contains date on which a particaular Defect no. has been Fixed or SendBack in Format "2005-11-01 18:07:40".

->The "Action_name" column contains action taken for defects. It may contain values namely Fixed or SendBack.

It is possible that same Defect no. might have Fixed or SendBack more than 1 time.

Following are my requirement:

- There are some DefectNo. which have duplicate entries (with different Action_name and Fixed&SendBack Date).
- Get the latest entry for each DefectNo. (i.e. the latest Fixed/SendBack Date) so that all Defect no become unique.
- Against each DefectNo. it should also get when was it Sendback and how many times it was sent back.

I know its quite confusing but with my level best I have clarified every thing above that what my requiremetn is?

Pls requesting you all to give me the solution as soon as possible.
I would be thankful to everyone for their effort.

Regards,

 

[BrianB]

I think this does it :-

Sub test()
    Dim FromSheet As Worksheet
    Dim ToSheet As Worksheet
    Dim FromRow As Long
    Dim ToRow As Long
    Dim Defect As String
    Dim MyDate As Date
    Dim MyDateCol As Integer
    Dim MyCount As Integer
    Dim LastRow As Long
    '----------------------------------------------
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    '- active sheet
    Set FromSheet = ActiveSheet
    FromRow = 2
    LastRow = FromSheet.Range("A65536").End(xlUp).Row
    '- sort data
    FromSheet.Range("A1").Sort Key1:=Range("A2"), _
        Order1:=xlAscending, Key2:=Range("B2"), _
        Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom
    '-------------------------------------------------------
    '- new worksheet
    Set ToSheet = Worksheets.Add
    ToSheet.Range("A1:E1").Value = _
        Array("Defect", "Count", "Date1", "Date2", "Date3")
    ToRow = 2
    '-----------------------------------------------------------
    '- main loop to run down rows
    While FromSheet.Cells(FromRow, 1).Value <> ""
        Application.StatusBar = FromRow & " / " & LastRow
        MyCount = 0
        MyDateCol = 3
        Defect = FromSheet.Cells(FromRow, 1).Value
        ToSheet.Cells(ToRow, 1) = Defect
        While FromSheet.Cells(FromRow, 1).Value = Defect
            MyDate = FromSheet.Cells(FromRow, 2).Value
            ToSheet.Cells(ToRow, MyDateCol).Value = MyDate
            MyDateCol = MyDateCol + 1
            MyCount = MyCount + 1
            FromRow = FromRow + 1
        Wend
        ToSheet.Cells(ToRow, 2).Value = MyCount
        ToRow = ToRow + 1
    Wend
    '---------------------------------------------------------
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    MsgBox ("Done")
    Application.StatusBar = False
End Sub