Search code examples
vbaexcelgrouping

MS Excel make subtable / smart grouping


I have 2 data Sheets in MS Excel (2016) and need to analyze data from 2 sheets in one. Here is the schematic question of my need:

() - sheet1 - main

---------------------------
| id | product | manuf | q | 
---------------------------
| 001| prt_1   | man_1 |150|
---------------------------
| 002| prt_2   | man_2 |800|

() - sheet2 - submain

--------------------
|id | date | prices|
--------------------
|001|17.01 | 120   |
--------------------
|001|16.02 | 99    |
--------------------
|002|17.03 | 110   |
--------------------
|002|15.02 | 10    |

() - what I want to do is group them somehow like this

---------------------------
| id | product | manuf | q |
---------------------------
- | 001| prt_1   | man_1 |150|
  ----------------------------
   |001|17.01 | 120   |
   --------------------
   |001|16.02 | 99    |
   
---------------------------
+ | 002| prt_2   | man_2 |800|

in other words it is analog of MS Access SubDataSheet and I know how to do it in Access but need in Excel. I tried pivot table and power pivot but still no luck.

Second variant the same task but another version of source data. Instead of 2 sheets all data in one, but rows doubled and tripled. Don't know which variant is more suitable to do the desired grouping.

--------------------------------------------
| id | product | manuf | q |  date | prices|  
--------------------------------------------
|001 | prt_1   | man_1 |150| 17.01 | 120   |
--------------------------------------------
|001 | prt_1   | man_1 |150| 16.02 | 99    |

is there some VBA code to perform this? need help and advice.


Solution

  • something like this

    Public Sub Program()
        Dim i As Long
        Dim j As Long
        Dim k As Long
        i = 2
        j = 2
        k = 2
    
        Do While Worksheets("Sheet1").Cells(i, "A").Value <> ""
            'data from sheet1
            Worksheets("Result").Cells(k, "A").Value = Worksheets("Sheet1").Cells(i, "A").Value
            Worksheets("Result").Cells(k, "B").Value = Worksheets("Sheet1").Cells(i, "B").Value
            Worksheets("Result").Cells(k, "C").Value = Worksheets("Sheet1").Cells(i, "C").Value
            Worksheets("Result").Cells(k, "D").Value = Worksheets("Sheet1").Cells(i, "D").Value
    
            k = k + 1
    
            Do While Worksheets("Sheet1").Cells(i, "A").Value = Worksheets("Sheet2").Cells(j, "A").Value
                'data from sheet1
                Worksheets("Result").Cells(k, "A").Value = Worksheets("Sheet2").Cells(j, "A").Value
                Worksheets("Result").Cells(k, "B").Value = Worksheets("Sheet2").Cells(j, "B").Value
                Worksheets("Result").Cells(k, "C").Value = Worksheets("Sheet2").Cells(j, "C").Value
                Worksheets("Result").Cells(k, "D").Value = Worksheets("Sheet2").Cells(j, "D").Value
    
                k = k + 1
                j = j + 1
            Loop
    
            k = k + 1
            i = i + 1
        Loop
    End Sub