Extraction of Data based on dynamic criteria

thespardian

Board Regular
Joined
Aug 31, 2012
Messages
119
Office Version
  1. 2016
  2. 2013
Platform
  1. Windows
Q1.png


I simply want a dynamic way to group the above data . if there is empty cell in the column J (Centre) then ignore the whole row otherwise extract the data groups as per below format.


Q2.png


Any help will be highly appreciated.
Here is the link for excel file
Question123.xlsx
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
Why you don't Use Pivot Tables. It's Very good for you.
 
Upvote 0
Question123.xlsx
ABCDEFGHIJK
2
3CentreSr.DateCashierBill #Customer NameProduct CodeAmountTaxNet
4alpha11/4/2020Cashier 11000AAAAAi50012.5512.5
521/4/2020Cashier 11001BBBBBii1000251025
641/4/2020Cashier 11003AAAAAi2000502050
751/4/2020Cashier 21004CCCCCii250062.52562.5
881/4/2020Cashier 31007AAAAAii40001004100
9111/4/2020Cashier 11010CCCCCii5500137.55637.5
10141/4/2020Cashier 11013CCCCCii70001757175
11171/4/2020Cashier 11016AAAAAii8500212.58712.5
12201/4/2020Cashier 21019CCCCCii1000025010250
13231/4/2020Cashier 31022BBBBBii11500287.511787.5
14alpha Total
15beta31/4/2020Cashier 31002CCCCCiii150037.51537.5
1661/4/2020Cashier 11005BBBBBiii3000753075
1791/4/2020Cashier 11008BBBBBiii4500112.54612.5
18121/4/2020Cashier 11011BBBBBiii60001506150
19151/4/2020Cashier 21014AAAAAiii7500187.57687.5
20181/4/2020Cashier 31017AAAAAiii90002259225
21211/4/2020Cashier 11020CCCCCiii10500262.510762.5
22241/4/2020Cashier 11023AAAAAiii1200030012300
23beta Total
24gamma71/4/2020Cashier 11006GGGGGi350087.53587.5
25101/4/2020Cashier 21009CCCCCi50001255125
26131/4/2020Cashier 31012AAAAAi6500162.56662.5
27161/4/2020Cashier 11015BBBBBi80002008200
28191/4/2020Cashier 11018AAAAAi9500237.59737.5
29221/4/2020Cashier 11021BBBBBi1100027511275
30251/4/2020Cashier 21024AAAAAi12500312.512812.5
31gamma Total
32Grand Total
33
Sheet1
 
Upvote 0
If you are looking for VBA method then try this
Note: The result sheet is named as Result in my code

VBA Code:
Sub Extract()

Dim Centre$
Dim iRowData&, eRowData&, n&
Dim key As Variant
Dim cell As Range, rngData As Range
Dim dictCentre As Object
Dim wsData As Worksheet, wsResult As Worksheet
Dim wb As Workbook

Application.ScreenUpdating = False

Set wb = ActiveWorkbook
Set wsData = wb.Sheets("Data")
Set wsResult = wb.Sheets("Result")
Set dictCentre = CreateObject("Scripting.Dictionary")

iRowData = 12
eRowData = wsData.Range("A" & iRowData).End(xlDown).Row

Set rngData = wsData.Range("A" & iRowData, "A" & eRowData)

' Store all Center names
For Each cell In rngData
    Centre = cell.Offset(0, 9)
    If Not dictCentre.Exists(Centre) Then
        dictCentre.Add Centre, Centre
    End If
Next

' Write Result for each Centre
n = 6
For Each key In dictCentre.Keys
    wsResult.Range("A" & n) = UCase(key)
    n = n + 1
    For Each cell In rngData
        If cell.Offset(0, 9) = key Then
            wsData.Range("A" & cell.Row, "I" & cell.Row).Copy
            wsResult.Range("A" & n).PasteSpecial (xlPasteValuesAndNumberFormats)
            n = n + 1
        End If
    Next
    n = n + 1
Next

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub
 
Upvote 0
hi thespardian,
As @maabadi mentioned pivot table is a much easier way to group your data. try this guide. a complete walkthrough to your first pivot table.

or if you prefer vba, then assuming you have list of centers in column N of your worksheet, try the following in vba

VBA Code:
Sub abc()
Dim myrange As Range
Application.ScreenUpdating = False
Sheets("data").Activate
    LC = Cells(11, Columns.Count).End(xlToLeft).Column
    lr = Cells(Rows.Count, 1).End(xlUp).Row
   
ActiveSheet.Range("a11:j" & lr).AutoFilter
centerlr = Cells(Rows.Count, 14).End(xlUp).Row

For y = 12 To centerlr
    Sheets("data").Activate
    Range("a11:j" & lr).AutoFilter
    myvalue = Cells(y, 14)
    Range("A11:j" & lr).AutoFilter Field:=10, Criteria1:=myvalue
    
    Set myrange = Sheets("datA").Range("a12:i" & lr)
    myrange.SpecialCells(xlCellTypeVisible).Copy

    With Sheets("DESIRED RESULT FORMAT")
        Sheets("DESIRED RESULT FORMAT").Activate
        If .Cells(5, 1) = "" Then
        .Cells(5, 1) = "S. NO"
        .Cells(5, 2) = "Date"
        .Cells(5, 3) = "Cashier"
        .Cells(5, 4) = "Bill #"
        .Cells(5, 5) = "Customer Name"
        .Cells(5, 6) = "Product Code"
        .Cells(5, 7) = "Amount"
        .Cells(5, 8) = "Tax"
        .Cells(5, 9) = "Net"
        End If
        destlr = Cells(Rows.Count, 1).End(xlUp).Row
        Sheets("DESIRED RESULT FORMAT").Range("a" & destlr + 1) = myvalue
        Sheets("DESIRED RESULT FORMAT").Range("a" & destlr + 2).PasteSpecial Paste:=xlPasteValues
    End With


hth...
Next y
Application.ScreenUpdating = True
Sheets("DESIRED RESULT FORMAT").Range("a5").Select
End Sub
 
Upvote 0
1. Select one Cell at your Table
2. Go to Insert Tab , first Item and Insert Pivot tables
3. If you want Desired result at new Worksheet Only Press OK. Otherwise select first Cell of Range that you want See Output at Location Box.
4.You see Right Panel at the Window And Column Names at them.
5.Select them One By One and drag them to Row Section after Last Item.
6. After finish working with Columns, Go to Design TAB and At first Item , Subtotal Select First Item (don't Show Subtotal)
7. And Design TAB and At first Item Select Report Layout and Change it to Show in Tabular form
7. at the Analyze tab go to Last section and UnSelect +/- Buttons
Each time you add item to your table, come to Pivot table Right Click & Refresh
 
Upvote 0
And If you want Sum of Each column Based Center Criteria Add That Columns to Column Section Not Row.
Then Right Click on Center Section and tick Subtotal Centre.
 
Upvote 0
hi thespardian,
As @maabadi mentioned pivot table is a much easier way to group your data. try this guide. a complete walkthrough to your first pivot table.

or if you prefer vba, then assuming you have list of centers in column N of your worksheet, try the following in vba

VBA Code:
Sub abc()
Dim myrange As Range
Application.ScreenUpdating = False
Sheets("data").Activate
    LC = Cells(11, Columns.Count).End(xlToLeft).Column
    lr = Cells(Rows.Count, 1).End(xlUp).Row
  
ActiveSheet.Range("a11:j" & lr).AutoFilter
centerlr = Cells(Rows.Count, 14).End(xlUp).Row

For y = 12 To centerlr
    Sheets("data").Activate
    Range("a11:j" & lr).AutoFilter
    myvalue = Cells(y, 14)
    Range("A11:j" & lr).AutoFilter Field:=10, Criteria1:=myvalue
   
    Set myrange = Sheets("datA").Range("a12:i" & lr)
    myrange.SpecialCells(xlCellTypeVisible).Copy

    With Sheets("DESIRED RESULT FORMAT")
        Sheets("DESIRED RESULT FORMAT").Activate
        If .Cells(5, 1) = "" Then
        .Cells(5, 1) = "S. NO"
        .Cells(5, 2) = "Date"
        .Cells(5, 3) = "Cashier"
        .Cells(5, 4) = "Bill #"
        .Cells(5, 5) = "Customer Name"
        .Cells(5, 6) = "Product Code"
        .Cells(5, 7) = "Amount"
        .Cells(5, 8) = "Tax"
        .Cells(5, 9) = "Net"
        End If
        destlr = Cells(Rows.Count, 1).End(xlUp).Row
        Sheets("DESIRED RESULT FORMAT").Range("a" & destlr + 1) = myvalue
        Sheets("DESIRED RESULT FORMAT").Range("a" & destlr + 2).PasteSpecial Paste:=xlPasteValues
    End With


hth...
Next y
Application.ScreenUpdating = True
Sheets("DESIRED RESULT FORMAT").Range("a5").Select
End Sub
Thanks a lot for your guidance. Its working well.
 
Upvote 0
you are welcome..... and thanks for the fedback
 
Upvote 0

Forum statistics

Threads
1,215,430
Messages
6,124,850
Members
449,194
Latest member
HellScout

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top