Return Unique Values with count

I'm using a macro that works fine to return a unique list from column C based on column D having the word "Major Task". Right now, I also have a formula applied to column H giving the count of "Sub Tasks" under each one of the "Major Tasks".

How can I instead get the result found in column I? Basically the count just to the right of the "Major Task".

Can this be done within the FilterUnique macro or is there another formula I can use? This is done for feeding the DV in M10 and M12 which is used on a larger scale for charting.

As a starter...

Option Explicit

Sub CountTask()
Dim cnt As Long, SubCnt As Long, i As Long, lr As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
Dim fnd1 As Range, fnd2 As Range
cnt = Application.WorksheetFunction.CountIf(Columns(3), "Major*")
For i = 1 To cnt
    Set fnd1 = Range("C:C").Find("Major Task " & i, LookIn:=xlValues, lookat:=xlWhole)
    Set fnd2 = Range("C:C").Find("Major Task " & i + 1, LookIn:=xlValues, lookat:=xlWhole)
    If i = cnt Then
        SubCnt = Application.WorksheetFunction.CountIf(Range(Cells(fnd1.Row, 3), Cells(lr, 3)), "Sub*")
    Else
        SubCnt = Application.WorksheetFunction.CountIf(Range(Cells(fnd1.Row, 3), Cells(fnd2.Row, 3)), "Sub*")
    End If
    Range("G" & i + 7).Resize(, 2) = Array("Major Task " & i, SubCnt)
Next i
End Sub

I do believe that is going to work just fine. Thank you very much.

.........................................
Thanks.gif

Hi Sintek,

What if the Major Tasks were not ordinal as in Major Task 1,2,3, etc, but instead, they are like...

C8 = Produces classified letters
C16 = Maintains database servers
C22 = Delivers classified letters

...and so with this structure, can I get the count between C8 and C16, C16 and C22, and then what's left?

Okay, not sure if this is a good way to go about it, but I modified to this. The Sub Tasks can also be actually task that do not start with Sub.

Sub FilterUnique()
    Dim rng As Range, Dn As Range
    With Sheet22
        .Columns(7).Clear
        Set rng = .Range(.Range("C8"), .Range("C" & .Rows.Count).End(xlUp))
    End With
    Debug.Print rng.Address
    With CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
        For Each Dn In rng
            If Not .Exists(Dn.Value) And Dn.Offset(, 1).Value = "Major Task" Then
                .Add Dn.Value, ""
            End If
        Next
        Sheet22.Range("G8").Resize(.Count).Value = Application.Transpose(.keys)
    End With
    Call CountTask
End Sub

Sub CountTask()
    Dim cnt As Long, SubCnt As Long, i As Long, lr As Long
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    Dim fnd1 As Range, fnd2 As Range
    cnt = Application.WorksheetFunction.CountIf(Columns(4), "Major*")
    For i = 1 To cnt
        Set fnd1 = Range("C:C").Find(Range("G" & i + 7), LookIn:=xlValues, lookat:=xlWhole)
        Set fnd2 = Range("C:C").Find(Range("G" & i + 8), LookIn:=xlValues, lookat:=xlWhole)
        If i = cnt Then
            SubCnt = Application.WorksheetFunction.CountIf(Range(Cells(fnd1.Row + 1, 3), Cells(lr, 3)), "*")
        Else
            SubCnt = Application.WorksheetFunction.CountIf(Range(Cells(fnd1.Row + 1, 3), Cells(fnd2.Row - 1, 3)), "*")
        End If
        Range("H" & i + 7).Value = SubCnt
    Next i
End Sub

apologies...had to put the little one down

No worries, I just had to run out to pick up my grandson.

So are the Headers now gonna be "Major Task*" and the sub headers "Sub*" or something else...

What about....

Sub CountTask()
Dim cnt As Long, SubCnt As Long, i As Long, lr As Long
Dim rng As Range, fnd1 As Range, fnd2 As Range
lr = Cells(Rows.Count, "A").End(xlUp).Row
cnt = Application.WorksheetFunction.CountIf(Columns(4), "Major*")
Set rng = Range("D8:D" & lr)
With rng
    .AutoFilter 1, "Major*"
    .Offset(, -1).SpecialCells(12).Copy Range("G8")
    .AutoFilter 1
End With
For i = 1 To cnt
    Set fnd1 = Range("C:C").Find(Range("G" & i + 7), LookIn:=xlValues, lookat:=xlWhole)
    Set fnd2 = Range("C:C").Find(Range("G" & i + 8), LookIn:=xlValues, lookat:=xlWhole)
    If i = cnt Then
        SubCnt = Application.WorksheetFunction.CountIf(Range(Cells(fnd1.Row + 1, 3), Cells(lr, 3)), "*")
    Else
        SubCnt = Application.WorksheetFunction.CountIf(Range(Cells(fnd1.Row + 1, 3), Cells(fnd2.Row - 1, 3)), "*")
    End If
    Range("H" & i + 7).Value = SubCnt
Next i
End Sub

Sorry about that. Here is an updated file which I should have posted the first time. Rookie mistake.

K...See amended in Post 10

Hi Sintek,

With a couple of tweaks, this works. Thanks again.

Sub CountTask2()
    Dim cnt As Long, SubCnt As Long, i As Long, lr As Long
    Dim rng As Range, fnd1 As Range, fnd2 As Range, rngMyRange As Range
    With Sheet22
        lr = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Columns("G:H").ClearContents
        cnt = Application.WorksheetFunction.CountIf(.Columns(4), "Major*")
        Set rng = .Range("D8:D" & lr)
        With rng
            .AutoFilter 1, "Major*"
        End With
        rng.Offset(, -1).SpecialCells(12).Copy
        .Range("G8").PasteSpecial xlPasteValues
        rng.AutoFilter
        For i = 1 To cnt
            Set fnd1 = .Range("C:C").Find(.Range("G" & i + 7), LookIn:=xlValues, lookat:=xlWhole)
            Set fnd2 = .Range("C:C").Find(.Range("G" & i + 8), LookIn:=xlValues, lookat:=xlWhole)
            If i = cnt Then
                SubCnt = Application.WorksheetFunction.CountIf(.Range(.Cells(fnd1.Row + 1, 3), .Cells(lr, 3)), "*")
            Else
                SubCnt = Application.WorksheetFunction.CountIf(.Range(.Cells(fnd1.Row + 1, 3), .Cells(fnd2.Row - 1, 3)), "*")
            End If
            .Range("H" & i + 7).Value = SubCnt
        Next i
        .Columns(7).EntireColumn.AutoFit
        Set rngMyRange = .Range("G8:G" & cnt + 7)
        ActiveWorkbook.Names.Add Name:="rngDV", RefersTo:=rngMyRange
    End With
End Sub

Hi Jindon and thank you for this solution.

Column D is the column with "Major Task" and so the title for each "Major Task" I would like to return is from column C.

a = Range("D8", Range("D" & Rows.Count).End(xlUp)).Value

Easy enough to change the range to reference where to find "Major Task", but how to have the code offset that range by -1 columns?

That does it. Thank you Jindon.

Great stuff jindon...Tx for the awesome code...love learning from you...