Help With A Formula To Calculate Only Filtered Data?

Just to clarify: there is no relevant detail in the other thread to which the OP refers, in which the OP merely asks if it is possible to perform calculations on filtered data. This is not a continuation of that thread, therefore, and no link to it is therefore necessary.

I decided to breakdown what I am looking for into even smaller parts, starting with a listing of values that remain after filtering the data.

See example below:
Between columns “F” and “J” are the start and finish points for the columns that will be filtered. Columns “K” to “O” are where the formulas representing each column “F” to “J” are. In the example column “H” is filtered to show the value of “2” leaving only the rows that contain that value. In columns “K” to “O” I want a formula to list the values that remain for each column but not listing repeats, so as in column “F” there are eight 1s and one 5 so in column “K” the formula would only list one 1 and one 5. Keeping the values in numerical of alphabetical order. This would continue for all the columns.

2C.jpg

See the attached spreadsheet for a better understanding. Thank you any help you can provide.

Are you required column "F" sum is "13", if yes then use subtotal formula.

I got it your requirement. (outpur within filter data only)
>In column "K" : You want data from column "F" (extract only unique values)
>In column "L" : You want data from column G" (using sort function)
>In column "M" : You want data from column "H" (extract only unique values)
>Not know regarding criteria in column "N" & "O" data.
This is not done by formula. I think this can be done by vba micro. (I am not familiar with vba)

Sub Filter_it()

Dim i As Integer
Dim lr As Long
Dim keyrng As Range

Application.ScreenUpdating = False

   lr = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

    Range("A3:O" & lr).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "K1:K2"), CopyToRange:=Range("AA3:AO" & lr), Unique:=False
        
    For i = 1 To 6

        Set keyrng = Range(Cells(4, 36 + i), Cells(4, 36 + i))
    '
    ' Remove Duplicates
    '
        Range(Cells(3, 36 + i), Cells(lr, 36 + i)).Select
        ActiveSheet.Range(Cells(3, 36 + i), Cells(lr, 36 + i)).RemoveDuplicates Columns:=1, Header:= _
            xlYes
     '
     '  Sort
     '
        ActiveSheet.Sort.SortFields.Clear
        ActiveSheet.Sort.SortFields.Add Key:=keyrng, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortTextAsNumbers
        With ActiveSheet.Sort
            .SetRange Range(Cells(4, 36 + i), Cells(lr, 36 + i))
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
    Next i
    
    Application.ScreenUpdating = True
    
    Range("AA1").Select
    
End Sub

Filtered data is copied to AA3 (across and down).

Duplicates removed from columns AK to AO and then sorted.

Criteria for filter are in K1:K2:

K1= Filter Column heading,

K2= filter value

Re 1.) How many (max) values are you likely to choose? Using Advanced Filter, the values have to placed in the same column so they would go in L2, L3 etc.

And do you want to filter on more than one field at a time?

Why add column F which is just a repeat of E ? You don't need both.

See the atatched:

Sub Filter_it()

Dim i As Integer
Dim lr As Long
Dim keyrng As Range

Application.ScreenUpdating = False

Worksheets("Filtered").Range("A1:ZZ1000").ClearContents

Worksheets("Filter_Formula").Activate

   lr = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

    Range("A4:O" & lr).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "Crit"), CopyToRange:=Range("Filter_Start"), Unique:=False
        
    Worksheets("Filtered").Activate
        
    For i = 11 To 15
    
       lr = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

        Set keyrng = Range(Cells(2, i), Cells(2, i))
    '
    ' Remove Duplicates
    '
        Range(Cells(1, i), Cells(lr, i)).Select
        ActiveSheet.Range(Cells(1, i), Cells(lr, i)).RemoveDuplicates Columns:=1, Header:= _
            xlYes
     '
     '  Sort
     '
        ActiveSheet.Sort.SortFields.Clear
        ActiveSheet.Sort.SortFields.Add Key:=keyrng, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortTextAsNumbers
        With ActiveSheet.Sort
            .SetRange Range(Cells(2, i), Cells(lr, i))
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
    Next i
    
    Insert_Columns
    
    Columns("K:AN").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
    End With
    
    Application.ScreenUpdating = True
    
    Range("A1").Select
    
End Sub
Sub Insert_Columns()

   headings = Array(" ", "Total: #/%", "P: #/%", "L: #/%", "B: #/%", "WP: #/%")
   pl = Array(" ", "*", "P", "L", "B", "WP")

    Columns("L:P").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("R:V").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("X:AB").Select
     Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("AD:AH").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    
    nfrow = Cells(Rows.Count, "A").End(xlUp).Row - 1
    
    ncc = 5
    
    For i = 11 To 35 Step 6
    
        ncc = ncc + 1
        
        For j = 1 To 5
            nn = i + j
            Cells(1, nn) = headings(j)
            Call Calc_NP(i, nn, ncc, nfrow, pl(j))
        Next j
        
        nlast = Cells(Rows.Count, i).End(xlUp).Row
        
        For k = 2 To nlast
         pct = Cells(k, i + 1) / (nfrow - 1)
         Cells(k, i + 1) = Cells(k, i + 1) & "/" & Format(pct, "#0.0%")
        Next k
        
    Next i
    
End Sub
Sub Calc_NP(col, cc, c, nfr, cat)

nlast = Cells(Rows.Count, col).End(xlUp).Row

For i = 2 To nlast
   If cat = "*" Then
        Var1 = Cells(i, col)
        Var2 = Application.WorksheetFunction.CountIf(Range(Cells(2, c), Cells(nfr, c)), Var1)
        pct = Var2 / nfr
        Cells(i, cc) = Var2
'        Cells(i, cc) = Var2 & "/" & Format(pct, "#0.0%")
    Else
        Var1 = Cells(i, col)
        Var2 = Application.WorksheetFunction.CountIfs(Range(Cells(2, c), Cells(nfr, c)), Var1, Range(Cells(2, 5), Cells(nfr, 5)), cat)
        pct = 0
        If Cells(i, col + 1) <> 0 Then pct = Var2 / Cells(i, col + 1)
        Cells(i, cc) = Var2 & "/" & Format(pct, "#0.0%")
    End If
    
Next i

End Sub

Data is output to Sheet "Filtered"

On Sheet "Filtered_Formula" enter filter criteria in K2:O2. The number of row entries must be the same for each filter field.

in K2 enter the number of rows of filter data.

In the attached change value in K2 (1 to 3) to see results.

In Column E: I used the abbreviations ("P","L","B")

Your are very welcome. I learned a few lessons doing the project so appreciated the chance to "have a go"

Thank you for the feedback and rep.

If that takes care of your original question, please select Thread Tools from the menu link above and mark this thread as SOLVED. Thanks.