Is there any method to get data with specific criteria. with VBA or Pivot Table

I have data set want extract data from data set with specific criteria using VBA, Macros etc.
Specific.xlsx

For good enough readers only :

According to your attachment first in Sheet2 :
- Class must be in cell A5
- its criteria in cell A6 Text formatted
- first month in cell C6
- last month in cell E6 …

A beginner starter Excel basics VBA demonstration to paste only to the Sheet2 worksheet module :

PHP Code: 

Sub Demo1()
        V = UsedRange.Rows(UsedRange.Rows.Count).Row:  If V > 6 Then Rows("7:" & V).Delete
    With [Sheet1!A3].CurrentRegion
        V = Application.Match(Array([C6], [E6]), .Rows(1), 0):  If Application.Count(V) < 2 Then Beep: Exit Sub
        If V(1) > V(2) Then Beep: Exit Sub
        If Left([A6], 1) <> "=" Then [A6] = "=" & [A6]
       .Range("A1:E1").Copy [A8]
       .Cells(V(1)).Resize(, V(2) - V(1) + 1).Copy [F8]
       .AdvancedFilter 2, [A5:A6], [A8].CurrentRegion
    End With
    With [A8].CurrentRegion.Columns
             .Range("A2:A" & .Rows.Count) = Evaluate("ROW(1:" & .Rows.Count & ")")
        With .Item(.Count + 1)
             .Font.Bold = True
             .FormulaR1C1 = "=SUM(RC[" & 6 - .Column & "]:RC[-1])"
             .Cells(1) = "Total"
        End With
        With .Cells(.Rows.Count, 6)(2).Resize(, .Count - 4)
             .Font.Bold = True
             .Formula = "=SUM(F9:F" & .Row - 1 & ")"
        End With
    End With
End Sub 


► Do you like it ? ► ► So thanks to click on bottom left star icon « ★ Add Reputation » ! ◄ ◄

Hello. I show you another variant:

PHP Code: 

Sub Macro9()
Dim tb1 As ListObject, tb2 As ListObject, C As Range, D As Range, qCol%
Application.ScreenUpdating = False
Rem ----------------->
Set tb1 = Range("Table1").ListObject: Set tb2 = Range("Table2").ListObject
With tb2.Range
  If .Rows.Count > 2 Then .Offset(2).Resize(.Rows.Count - 2).Delete xlShiftUp
  If .Columns.Count > 6 Then .Offset(, 6).Resize(, .Columns.Count - 6).Columns.Delete xlShiftToLeft
End With
Rem ----------------->
Set C = tb1.HeaderRowRange.Find(Range("Crit2"), LookAt:=xlWhole)
Set D = tb1.HeaderRowRange.Find(Range("Crit3"), LookAt:=xlWhole)
qCol = Range(C, D).Columns.Count
tb2.Resize tb2.Range.Resize(2, 6 + qCol): tb2.HeaderRowRange(6).Resize(, 1 + qCol).FillRight
tb2.HeaderRowRange(6).Resize(, qCol) = Range(C, D).Value
tb2.HeaderRowRange(tb2.ListColumns.Count) = tb1.HeaderRowRange(tb1.ListColumns.Count).Value
Rem ----------------->
[aa1] = Range("Crit1")(0).Value: [aa2] = "=""=" & Range("Crit1") & """"
tb1.Range.AdvancedFilter 2, [aa1:aa2], tb2.HeaderRowRange, False
[aa1:aa2].Delete xlShiftUp
Rem ----------------->
tb2.Resize tb2.Range.CurrentRegion
tb2.Range(2, 1) = 1: tb2.ListColumns(1).DataBodyRange.DataSeries
tb2.ListColumns(tb2.ListColumns.Count).DataBodyRange = "=Sum(RC[-" & qCol & "]:RC[-1])"
End Sub 


Just for the fun of it...

Please Login or Register  to view this content.

Originally Posted by meraz

Thank you for the effort and creating new sheet for me, but I got security Risk Message "Microsoft has blocked macros from running because source of these file is untrusted."

I imagine this message appears when you open the workbook.

However, it also offers you two alternatives: enable or disable macros... Select 'Enable' macros!

Originally Posted by Artik

Pillow reading:
https://answers.microsoft.com/en-us/...7-a0801e264cc2
https://learn.microsoft.com/en-us/de...macros-blocked

Artik

Thanks, @Artik.