help on macro to count single so and call type also

[breadwinner]

i have set of date in A:A,B:B,C:C at last F:F column contains fill serial no{1,2,3,4.....}
CRM DATE In A:A column
SO In B:B column
CALL TYPE In C:C column

i have set of macro to count how many times its so gets repeats in column with LABOR ONLY & LABOR & PART in call type column C:C
but now i calculates both LABOR ONLY & LABOR & PART which are available against so' other wise it gets error

for e.g for if so DE3233334 only one time and call type LABOR ONLY i want result = "0"
if so WEE412122 repeats four time but call type LABOR & PART repeats four time i want result as per date sort from min to max 0,1,2,3.

please find the code

Option Explicit




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

here getting error like this msg(runtime error 1004 no cells were found
stops at "

Set filt = r.Offset(1, 0).Resize(r.Rows.Count - 1).SpecialCells(xlCellTypeVisible)

"

find the attachment!!!