count the values from smallest date with criteria!!! help excel formula

**breadwinner** · 09-06-2013, 06:09 AM

Dear expert'

i have tried it but not able to complete please i need ur help on this

I have multiple repeated So's in B:B , in column A:A have date column for when So's was created..
Then column C:C have two criteria only (LABOUR&PART AND LABOUR ONLY)

E.G IF IN COLUMN A:A HAVE DIFFERENT DATES FOR SO NO A123 REPEATS 6 TIMES IN B:B COLUMN BUT 3 LABOUR AND PART ANOTHER 3 LABOUR ONLY I WANT FIND OUT AT WHAT NO OF TIMES ITS REPEATED SO'S

,FOR THE FIRST TIME DATE&SO'S EITHER LABOURONLY OR PARTS I WANT RESULT "0 " FOR THE SMALLEST DATE OF CRM

CRM DATE SO'S PARTS TYPE RESULT EXPECTED

1-AUG-2013 A123 LABOUR ONLY RESULT SHOULD 0
3-AUG-2013 A123 LABOUR ONLY RESULT SHOULD 2
2-AUG-22013 A123 LABOUR ONLY RESULT SHOULD 1

1-AUG-2013 A123 LABOUR AND PARTS RESULT SHOULD 0
3-AUG-2013 A123 LABOUR AND PARTS RESULT SHOULD 2
2-AUG-22013 A123 LABOUR AND PARTS RESULT SHOULD 1

**venkat1926** · 09-08-2013, 09:32 AM

1.copy the data IN SHEET 1 as it is in sheet 3 for comparing expected resllt of col. E and result of macro in col E
2.in sheet 1 delete cells in column E. DO NOT DELETE COLUMN e
this is the source data
3.in sheet 1 a helper column in F that is F2 is 1,F3 is 2 etc till F22
4.copy sheet 1 as desgined to sheet 2 repeat sheet2 so that source data is preserved

the file "breadwiner 130908" is attached as per 1,2,3,4 above

the macro "testone" is in the module
if you run the macro the result will be sheet (expected result column E)

there appears to be some error in your manual ranking of the middle portion that is rows 8 to 14. check once again whether the macro result is correct.

the macro is also appended below for reference

Sub testone()
    Dim so As Range, calltype As Range, unq1 As Range, unq2 As Range
    Dim cunq1 As Range, cunq2 As Range, r As Range, j As Integer, k As Integer
    Dim filt As Range
    Dim crm As Range, result As Range
    Application.ScreenUpdating = False
    Worksheets("sheet1").Cells.Clear
    Worksheets("sheet2").Cells.Copy Worksheets("sheet1").Range("A1")
    Worksheets("sheet1").Activate
    Set r = Range("a1").CurrentRegion
    r.Sort key1:=Range("B1"), key2:=Range("C1"), Header:=xlYes
    '=============

    Set so = Range(Range("B1"), Range("B1").End(xlDown))
    Set calltype = so.Offset(0, 1)
    Set unq1 = Range("A1").End(xlDown).Offset(5, 0)
    Set unq2 = unq1.Offset(0, 1)
    so.AdvancedFilter xlFilterCopy, , unq1, True
    calltype.AdvancedFilter xlFilterCopy, , unq2, True
    Set unq1 = Range(unq1.Offset(1, 0), unq1.End(xlDown))
    Set unq2 = Range(unq2.Offset(1, 0), unq2.End(xlDown))
    For Each cunq1 In unq1
        ActiveSheet.AutoFilterMode = False
        r.AutoFilter 2, cunq1
        For Each cunq2 In unq2
            r.AutoFilter 3, cunq2
            Set filt = r.Offset(1, 0).Resize(r.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
            Set crm = filt.Columns("A:A")
            'msgbox crm.Address
            Set result = filt.Columns("E:E")
            'msgbox result.Address
            j = filt.Rows.Count
            For k = 1 To j
                result.Cells(k, 1) = WorksheetFunction.Rank(crm.Cells(k, 1), crm, 1) - 1

            Next k


        Next cunq2
        ActiveSheet.AutoFilterMode = False
    Next cunq1

    ActiveSheet.AutoFilterMode = False
    r.Sort key1:=Range("F1"), Header:=xlYes
    MsgBox "macro over"
    Application.ScreenUpdating = True
End Sub