Split data are existed in two sheets to two sheets for each group

abdo meghari

Well-known Member
Joined
Aug 3, 2021
Messages
704
Office Version
  1. 2019
Hello,
I would macro to deal with about 10000 rows and contain about 100 groups for each sheet.
in SELLING,BUYING sheet should split data based on column B for each group ,as to column C should match with sheets names(SALES,COSTING) are already existed and show data for each sheet based on sheet name is existed in column C for SELLING,BUYING sheets.



ABDO (1).xls
ABCDEFGHI
1DATEGROUP/COMPANYTYPEBRAND NODESCRIBEUNITQTYSELLING PRICETOTAL
201/01/2025GOMMESTSALES1769 BLUE TR414 100 PCSPIECE250.45011.250
301/01/2025TIRESSALES1130GC 1200R20 QAZ183 CHIPIECE51,450.0007,250.000
401/01/2025BATTERYSALES1118XPRO 70A L KORPIECE1350.000350.000
501/01/2025BATTERYSALES1119XPRO 70A R KORPIECE2300.000600.000
602/01/2025GOMMESTSALES1774 BOAF0-50PIECE2100.900189.000
703/01/2025GOMMESTSALES1775 XIA TW-9250 250MLPIECE10.9500.950
804/01/2025TIRESSALES1123BS 750R16 R230 JAPPIECE10450.0004,500.000
905/01/2025TIRESSALES1124BS 750R16 VSJ JAPPIECE8750.0006,000.000
1006/01/2025GOMMESTSALES1752 EUS-65 ROUND PATCH 65X65 PIECE102.50025.000
1106/01/2025GOMMESTSALES1758 P1108 TAIWANPIECE115.50060.500
1206/01/2025GOMMESTSALES1773 PTO-2301-R 0.6X100MM.PIECE881.500132.000
1306/01/2025GOMMESTSALES1765 VMTC 7.50-16 V3-02-7PIECE160.00060.000
1406/01/2025TIRESSALES1125BS 1200R20 G580 JAPPIECE22,500.0005,000.000
1506/01/2025TIRESSALES1126BS 315/80R22.5 R184 JAPPIECE801,950.000156,000.000
1607/01/2025TIRESSALES1127BS 1400R20 VSJ JAPPIECE14,000.0004,000.000
1708/01/2025GOMMESTSALES1767HEADER OF PRESSUREPIECE14.0004.000
1809/01/2025GOMMESTSALES1768LEAD 10GM WIDEPIECE30.7502.250
1910/01/2025GOMMESTSALES1769LEAD 10GM TIDEPIECE70.8505.950
2011/01/2025GOMMESTSALES1770LEAD 15GM WIDEPIECE40.6502.600
2112/01/2025GOMMESTSALES1771LEAD 15GM TIDEPIECE60.9505.700
2213/01/2025GOMMESTSALES1772LEAD 20GM WIDEPIECE70.7004.900
2314/01/2025GOMMESTSALES1773LEAD 20GM TIDEPIECE160.80012.800
2415/01/2025TIRESSALES1128BS 1200R24 G580 JAPPIECE22,800.0005,600.000
2516/01/2025TIRESSALES1129GC 1200R20 AZ026 CHIPIECE21,350.0002,700.000
2617/01/2025BATTERYSALES1120XPRO 90A R KORPIECE2425.000850.000
2718/01/2025BATTERYSALES1121HANKOOK 150A L KORPIECE10850.0008,500.000
2819/01/2025BATTERYSALES1123ASIMCO 150A L KORPIECE1750.000750.000
SELLING
Cell Formulas
RangeFormula
I2:I28I2=H2*G2




ABDO (1).xls
ABCDEFGHI
1DATEGROUP/COMPANYTYPEBRAND NODESCRIBEUNITQTYCOSTING PRICETOTAL
201/01/2025GOMMESTCOSTING1765 VMTC 7.50-16 V3-02-7PIECE10045.0004,500.000
302/01/2025GOMMESTCOSTING1767HEADER OF PRESSUREPIECE1100.55060.500
403/01/2025TIRESCOSTING1126BS 315/80R22.5 R184 JAPPIECE1001,900.000190,000.000
504/01/2025TIRESCOSTING1127BS 1400R20 VSJ JAPPIECE203,900.00078,000.000
605/01/2025TIRESCOSTING1130GC 1200R20 QAZ183 CHIPIECE301,400.00042,000.000
705/01/2025TIRESCOSTING1133GC 1200R20 QAZ188 CHIPIECE201,500.00030,000.000
806/01/2025BATTERYCOSTING1118XPRO 70A L KORPIECE1300.000300.000
907/01/2025BATTERYCOSTING1119XPRO 70A R KORPIECE2250.000500.000
1008/01/2025GOMMESTCOSTING1768LEAD 10GM WIDEPIECE2000.25050.000
1109/01/2025GOMMESTCOSTING1769 BLUE TR414 100 PCSPIECE1250.33041.250
1210/01/2025GOMMESTCOSTING1752 EUS-65 ROUND PATCH 65X65 PIECE1001.500150.000
1311/01/2025GOMMESTCOSTING1758 P1108 TAIWANPIECE153.50052.500
1412/01/2025TIRESCOSTING1125BS 1200R20 G580 JAPPIECE102,400.00024,000.000
1513/01/2025TIRESCOSTING1128BS 1200R24 G580 JAPPIECE202,700.00054,000.000
1614/01/2025TIRESCOSTING1129GC 1200R20 AZ026 CHIPIECE301,300.00039,000.000
1715/01/2025GOMMESTCOSTING1773 PTO-2301-R 0.6X100MM.PIECE901.250112.500
1816/01/2025GOMMESTCOSTING1775 XIA TW-9250 250MLPIECE120.4905.880
1917/01/2025GOMMESTCOSTING1769LEAD 10GM TIDEPIECE170.3505.950
2018/01/2025GOMMESTCOSTING1770LEAD 15GM WIDEPIECE440.44019.360
2119/01/2025GOMMESTCOSTING1771LEAD 15GM TIDEPIECE660.45029.700
2220/01/2025GOMMESTCOSTING1772LEAD 20GM WIDEPIECE770.46035.420
2321/01/2025GOMMESTCOSTING1773LEAD 20GM TIDEPIECE1660.47078.020
2421/01/2025GOMMESTCOSTING1774 BOAF0-50PIECE2500.480120.000
2521/01/2025GOMMESTCOSTING1775 BOAF0-51PIECE1000.65065.000
2621/01/2025TIRESCOSTING1123BS 750R16 R230 JAPPIECE50400.00020,000.000
2721/01/2025TIRESCOSTING1124BS 750R16 VSJ JAPPIECE80700.00056,000.000
2822/01/2025BATTERYCOSTING1122NOVA 150A L KORPIECE1700.000700.000
2923/01/2025BATTERYCOSTING1123ASIMCO 150A L KORPIECE2700.0001,400.000
3024/01/2025BATTERYCOSTING1120XPRO 90A R KORPIECE2400.000800.000
3125/01/2025BATTERYCOSTING1121HANKOOK 150A L KORPIECE10800.0008,000.000
BUYING
Cell Formulas
RangeFormula
I2:I31I2=H2*G2




ABDO (1).xls
ABCDEFGH
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
SALES


ABDO (1).xls
ABCDEFG
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
COSTING


when split data if the C3,E3 are empty in SPLIT sheet
ABDO (1).xls
ABCDEF
1
2FROM DATETO DATE
3
4
5
6
7
8
split



then should split data like this
ABDO (1).xls
ABCDEFG
1GROUP/COMPANY: GOMMEST
2ITEMBRAND NODESCRIBEUNITQTYSELLING PRICETOTAL
311769 BLUE TR414 100 PCSPIECE250.45011.250
421752 EUS-65 ROUND PATCH 65X65 PIECE102.50025.000
531758 P1108 TAIWANPIECE115.50060.500
641773 PTO-2301-R 0.6X100MM.PIECE881.500132.000
751765 VMTC 7.50-16 V3-02-7PIECE160.00060.000
861767HEADER OF PRESSUREPIECE14.0004.000
971768LEAD 10GM WIDEPIECE30.7502.250
1081769LEAD 10GM TIDEPIECE70.8505.950
1191770LEAD 15GM WIDEPIECE40.6502.600
12101771LEAD 15GM TIDEPIECE60.9505.700
13111772LEAD 20GM WIDEPIECE70.7004.900
14121773LEAD 20GM TIDEPIECE160.80012.800
15131774 BOAF0-50PIECE2100.900189.000
16141775 XIA TW-9250 250MLPIECE10.9500.950
17SELLING TOTAL516.900
18
19
20
21GROUP/COMPANY: TIRES
22ITEMBRAND NODESCRIBEUNITQTYSELLING PRICETOTAL
2311123BS 750R16 R230 JAPPIECE10450.0004,500.000
2421124BS 750R16 VSJ JAPPIECE8750.0006,000.000
2531125BS 1200R20 G580 JAPPIECE22,500.0005,000.000
2641126BS 315/80R22.5 R184 JAPPIECE801,950.000156,000.000
2751127BS 1400R20 VSJ JAPPIECE14,000.0004,000.000
2861128BS 1200R24 G580 JAPPIECE22,800.0005,600.000
2971129GC 1200R20 AZ026 CHIPIECE21,350.0002,700.000
3081130GC 1200R20 QAZ183 CHIPIECE51,450.0007,250.000
31SELLING TOTAL191,050.000
32
33
34GROUP/COMPANY: BATTERY
35ITEMBRAND NODESCRIBEUNITQTYSELLING PRICETOTAL
3611118XPRO 70A L KORPIECE1350.000350.000
3721119XPRO 70A R KORPIECE2300.000600.000
3831120XPRO 90A R KORPIECE2425.000850.000
3941121HANKOOK 150A L KORPIECE10850.0008,500.000
4051123ASIMCO 150A L KORPIECE1750.000750.000
41SELLING TOTAL11,050.000
SALES
Cell Formulas
RangeFormula
G36:G40,G23:G30,G3:G16G3=F3*E3
G17G17=SUM(G3:G16)
G31G31=SUM(G23:G30)
G41G41=SUM(G36:G40)



ABDO (1).xls
ABCDEFG
1GROUP/COMPANY: GOMMEST
2ITEMBRAND NODESCRIBEUNITQTYCOSTING PRICETOTAL
351765 VMTC 7.50-16 V3-02-7PIECE10045.0004,500.000
461767HEADER OF PRESSUREPIECE1100.55060.500
571768LEAD 10GM WIDEPIECE2000.25050.000
611769 BLUE TR414 100 PCSPIECE1250.33041.250
721752 EUS-65 ROUND PATCH 65X65 PIECE1001.500150.000
831758 P1108 TAIWANPIECE153.50052.500
941773 PTO-2301-R 0.6X100MM.PIECE901.250112.500
10141775 XIA TW-9250 250MLPIECE120.4905.880
1181769LEAD 10GM TIDEPIECE170.3505.950
1291770LEAD 15GM WIDEPIECE440.44019.360
13101771LEAD 15GM TIDEPIECE660.45029.700
14111772LEAD 20GM WIDEPIECE770.46035.420
15121773LEAD 20GM TIDEPIECE1660.47078.020
16131774 BOAF0-50PIECE2500.480120.000
17141775 BOAF0-51PIECE1000.65065.000
18COSTING TOTAL715.580
19
20
21GROUP/COMPANY: TIRES
22ITEMBRAND NODESCRIBEUNITQTYCOSTING PRICETOTAL
2311125BS 1200R20 G580 JAPPIECE102,400.00024,000.000
2421128BS 1200R24 G580 JAPPIECE202,700.00054,000.000
2531129GC 1200R20 AZ026 CHIPIECE301,300.00039,000.000
2641123BS 750R16 R230 JAPPIECE50400.00020,000.000
2751124BS 750R16 VSJ JAPPIECE80700.00056,000.000
2861126BS 315/80R22.5 R184 JAPPIECE1001,900.000190,000.000
2971127BS 1400R20 VSJ JAPPIECE203,900.00078,000.000
3081130GC 1200R20 QAZ183 CHIPIECE301,400.00042,000.000
3191133GC 1200R20 QAZ188 CHIPIECE201,500.00030,000.000
32COSTING TOTAL455,000.000
33
34
35GROUP/COMPANY: BATTERY
36ITEMBRAND NODESCRIBEUNITQTYCOSTING PRICETOTAL
3711118XPRO 70A L KORPIECE1300.000300.000
3821119XPRO 70A R KORPIECE2250.000500.000
3931122NOVA 150A L KORPIECE1700.000700.000
4041123ASIMCO 150A L KORPIECE2700.0001,400.000
4151120XPRO 90A R KORPIECE2400.000800.000
4261121HANKOOK 150A L KORPIECE10800.0008,000.000
43COSTING TOTAL11,700.000
COSTING
Cell Formulas
RangeFormula
G37:G42,G23:G31,G3:G17G3=F3*E3
G18G18=SUM(G6:G17)
G32G32=SUM(G25:G31)
G43G43=SUM(G37:G42)




otherwise when there are dates then split within dates in C3,E3 in SPLIT sheet.
thanks.
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Hello,

It is for sure doable in VBA, but what about PowerQuery ? I mean it is literally designed for this kind of job, and it is way easier to maintain/adapt. You just have to do a group by and reorder some columns and you're good to go.
 
Upvote 0
Do you need the data to be split as it is or grouped by Brand No and or Describe and summed appropriately?
 
Upvote 0
Give this a go.

If you want all of the data then set the dates to cover the entire period represented in the source sheets.

VBA Code:
Public Sub subSplitData()
Dim WsSource As Worksheet
Dim WsDestination As Worksheet
Dim rngData As Range
Dim lngRows As Long
Dim i As Integer
Dim arrUnique() As Variant
Dim intSum As Integer
Dim rngCell As Range
Dim arrFeed(1 To 2, 1 To 2) As Variant
Dim intLoop As Integer
Dim dteStart As Long
Dim dteEnd As Long
Dim strSheets As String

  ActiveWorkbook.Save
    
  arrFeed(1, 1) = "SELLING"
  arrFeed(1, 2) = "SALES"
  arrFeed(2, 1) = "BUYING"
  arrFeed(2, 2) = "COSTING"
  
  Application.ScreenUpdating = False
  
  For intLoop = 1 To UBound(arrFeed)
  
    Set WsSource = Worksheets(arrFeed(intLoop, 1))
      
    ' Create destination folder.
    Call subCreateSheet(arrFeed(intLoop, 2))
    Set WsDestination = Worksheets(arrFeed(intLoop, 2))
    
    strSheets = strSheets & vbCrLf & WsDestination.Name
      
    With WsSource.Range("A1").CurrentRegion
          
        .AutoFilter
               
        .AutoFilter Field:=1, _
            Criteria1:=">=" & Worksheets("Split").Range("C3"), _
            Operator:=xlAnd, _
            Criteria2:="<=" & Worksheets("Split").Range("E3")
            
        .SpecialCells(xlCellTypeVisible).Copy
        
        With WsDestination
          .Activate
          .Range("A1").PasteSpecial xlPasteAll
          .Range("A1").Select
        End With
        
        .AutoFilter
      
    End With
      
    WsDestination.Range("A1").CurrentRegion.Sort Key1:=Range("B1"), Order1:=xlAscending, _
                           Key2:=Range("E1"), Order2:=xlAscending, Header:=xlYes
                           
    ' **************************************************************************************
    ' Populate the arrUnique array with the unique GROUP/COMPANY values and the sum of
    ' the corresponding rows in the TOTAL column.
    ' **************************************************************************************
    With WsDestination.Range("A1").CurrentRegion
      Set rngData = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
      .Columns(2).AdvancedFilter _
        Action:=xlFilterCopy, CopyToRange:=WsDestination.Range("K1"), Unique:=True
    End With
      
    WsDestination.Range("K1").CurrentRegion.Offset(0, 1).Formula2 = _
      "=SUMIF(" & rngData.Columns(2).Address & ",K1," & rngData.Columns(9).Address & ")"
    
    With WsDestination.Range("K1").CurrentRegion
      arrUnique = .Value
      intSum = UBound(arrUnique)
      .ClearContents
    End With
    ' **************************************************************************************
    
    ' ***** Populate column 1 with the row numbers. *****
    With rngData.Columns(1)
      lngRows = .Rows.Count + 1
      .Formula2 = "=IF(ROW()=2,1,IF(B2<>B1,1,A1+1))"
      .NumberFormat = "0"
      .Value = .Value
    End With
        
    ' ***** Apply Number formats from source data *****
    rngData.Columns(8).NumberFormat = WsSource.Range("H2").NumberFormat
    
    With rngData.Columns(9)
      .NumberFormat = WsSource.Range("I2").NumberFormat
      .Value = .Value
    End With
    
    ' Loop through all rows from bottom to top.
    For i = lngRows To 2 Step -1
    
      ' Insert break of 2 rows where GROUP/COMPANY changes.
      ' Format grid of data.
      ' Apply totals.
      
      If Cells(i, 1).Value = 1 Then
      
        Cells(i, 1).Resize(4, 1).EntireRow.Insert
              
        Set rngCell = WsDestination.Cells(i + 4, 1)
        
        Call subBorders(rngCell.CurrentRegion)
      
        With rngCell.CurrentRegion
        
          With .Rows(1).Offset(-1, 0)
            .Value = WsDestination.Range("A1").CurrentRegion.Value
            .Cells(1).Value = "ITEM"
            .Font.Bold = True
          End With
                    
          Call subBorders(rngCell.CurrentRegion)
          
          Call subBorders(rngCell.Offset(.Rows.Count, .Columns.Count - 2).Resize(1, 2))
          
          With rngCell.Offset(.Rows.Count, .Columns.Count - 2).Resize(1, 2)
            .Cells(1).Value = "Selling Total"
            .Cells(2).Value = arrUnique(intSum, 2)
          End With
          
        End With
        
        With rngCell.Offset(-2, 4)
          .Value = arrUnique(intSum, 1)
          .Font.Bold = True
        End With
        
        intSum = intSum - 1
        
      End If
      
    Next i
    
    With WsDestination.Cells
      With .Font
        .Name = "Arial"
        .Size = 14
      End With
      .EntireColumn.AutoFit
      .RowHeight = 24
      .HorizontalAlignment = xlLeft
      .VerticalAlignment = xlCenter
      .IndentLevel = 1
      .Rows("1:2").EntireRow.Delete
      .Columns("B:C").Delete
      .EntireColumn.AutoFit
    End With
      
  Next intLoop
  
  Application.ScreenUpdating = True
  
  MsgBox "Report sheets created." & strSheets, vbOKOnly, "Confirmation"
  
End Sub

Private Sub subBorders(rngBorders As Range)

  With rngBorders.Borders
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = vbBlack
  End With

End Sub

Public Sub subCreateSheet(ByVal strSheet As String)
Dim WsActive As Worksheet

  Set WsActive = ActiveSheet

  If Evaluate("isref('" & strSheet & "'!A1)") Then
     Worksheets(strSheet).Cells.Clear
  Else
     Worksheets.Add After:=Sheets(Sheets.Count)
     ActiveSheet.Name = strSheet
  End If
  
  WsActive.Activate

End Sub
 
Upvote 0
@HighAndWilder
thanks for writing code for me , but unfortunately show application defined error
VBA Code:
 Set rngData = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
Which worksheet had it already created, SALES or COSTING?

It creates them on the first run in that order. After that it just clears the data before the sheet is repopulated.

Has either of those sheets got any data in it?
 
Upvote 0

Forum statistics

Threads
1,226,453
Messages
6,191,135
Members
453,642
Latest member
jefals

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