split tables from sheet to another based on data validation(dropdown list)

leap out

Active Member
Joined
Dec 4, 2020
Messages
271
Office Version
  1. 2016
  2. 2010
hello every one

I have many data in sheet1 it design by table what I want split the tables based on column b in sheet1 and based dropdown in b1 in sheet2 it should show divided tables in sheet2
and if there is b1 is empty then split all of data to many tables with considering every time I select the in b1 in sheet1 it should copy to the bottom
sheet1
DATECODEMODELORIGINBRANDQUANTITY
01/01/2020AA-OILCASTROLEU10-W40 208L240
01/02/2020AA1-OILCASTROLEU10-W40 1L123
01/03/2020AA2-OILCASTROLEU10-W40 4L1233
01/04/2020BB-OILENIEU10-W40 208L123
01/05/2020BB1-OILENIEU10-W40 1L122
01/06/2020BB2-OILENIEU10-W40 4L111
01/07/2020AA-OILCASTROLEU10-W40 208L10
01/08/2020AA1-OILCASTROLEU10-W40 1L22
01/09/2020BB1-OILENIEU10-W40 1L122
01/10/2020BB2-OILENIEU10-W40 4L111
01/11/2020CC1-OILQ8EU10-W40 208L123
01/12/2020CC2-OILQ8EU10-W40 4L124
01/13/2020CC3-OILQ8EU10-W40 1L125



if select in b1 in sheet2
CODEAA-OIL
DATECODEMODELORIGINBRANDQUANTITY
01/01/2020AA-OILCASTROLEU10-W40 208L240
01/07/2020AA-OILCASTROLEU10-W40 208L10
TOTAL250



if clear b1 in sheet2 the result should this
CODE
DATECODEMODELORIGINBRANDQUANTITY
01/01/2020AA-OILCASTROLEU10-W40 208L240
01/07/2020AA-OILCASTROLEU10-W40 208L10
TOTAL250
DATECODEMODELORIGINBRANDQUANTITY
01/02/2020AA1-OILCASTROLEU10-W40 1L123
01/08/2020AA1-OILCASTROLEU10-W40 1L22
TOTAL145
DATECODEMODELORIGINBRANDQUANTITY
01/03/2020AA2-OILCASTROLEU10-W40 4L1233
TOTAL1233
DATECODEMODELORIGINBRANDQUANTITY
01/04/2020BB-OILENIEU10-W40 208L123
TOTAL123
DATECODEMODELORIGINBRANDQUANTITY
01/05/2020BB1-OILENIEU10-W40 1L122
01/09/2020BB1-OILENIEU10-W40 1L122
TOTAL244
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
See if this works for you. Put this code in sheet2's module.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim mainTable As ListObject
    Dim newTable As ListObject
    Dim tableDestCell As Range
    Dim dvValueCell As Range
    Dim i As Long
    
    Set mainTable = Worksheets("Sheet1").ListObjects(1)
    
    If Target.Address = "$B$1" Then
    
        'Delete existing tables
        
        For i = Me.ListObjects.Count To 1 Step -1
            Me.ListObjects(i).Range.Clear
        Next
    
        Set tableDestCell = Me.Range("A3")

        If Target.Value <> "" Then
    
            'Filter main table column B on B1 value and copy visible rows to this sheet
            
            mainTable.Range.AutoFilter Field:=2, Criteria1:=Me.Range("B1").Value
            mainTable.Range.SpecialCells(xlVisible).Copy tableDestCell
            Set newTable = Me.ListObjects.Add(xlSrcRange, tableDestCell.CurrentRegion, , xlYes)
            newTable.ShowTotals = True
        
        Else
            
            'Filter main table column B on each data validation value and copy visible rows to this sheet
            
            For Each dvValueCell In Evaluate(Target.Validation.Formula1)
                mainTable.Range.AutoFilter Field:=2, Criteria1:=dvValueCell.Value
                mainTable.Range.SpecialCells(xlVisible).Copy tableDestCell
                Set newTable = Me.ListObjects.Add(xlSrcRange, tableDestCell.CurrentRegion, , xlYes)
                newTable.ShowTotals = True
                Set tableDestCell = tableDestCell.Offset(newTable.Range.Rows.Count + 2)
            Next
            
        End If
        
        'Clear filter on main table column B
        
        mainTable.Range.AutoFilter Field:=2

    End If
    
End Sub
 
Upvote 0
wow ! well done john just still one thing I no know if you see that in my post if I select every time a new in b1 then copy to the bottom I mean if I select a new in b1 then copy to under old data have ever searched

thanks:)
 
Upvote 0
glad to hear you again

for instance
I select from cell b1 "AA-OIL " it brings the data as in my pics 2 it's ok , but if I select another "AA1-OIL" the it copy the data under AA-OIL with considering if I repeat searching again for code like ""AA-OIL it shouldn't copy under data because I have already searched and existed in the sheet
 
Upvote 0
The first time you select "AA-OIL" in the B1 dropdown it should display the data in a new table below all the existing tables, if any.

The second and subsequent times you select "AA-OIL" it should update the existing table for "AA-OIL".

Is that correct?
 
Upvote 0
Try this code:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim mainTable As ListObject
    Dim ddTable As ListObject
    Dim tableDestCell As Range
    Dim dvValueCell As Range
    Dim rowCount As Long
    Dim i As Long
    
    Set mainTable = Worksheets("Sheet1").ListObjects(1)
    
    If Target.Address = "$B$1" Then
            
        If Target.Value <> "" Then
    
            'Filter main table column B on dropdown value and copy visible rows to the table named "Table_xxxx" on this sheet, creating the table if necessary
            
            Set ddTable = Nothing
            On Error Resume Next
            Set ddTable = Me.ListObjects("Table_" & Target.Value)
            On Error GoTo 0
            
            If ddTable Is Nothing Then
            
                'Table for this dropdown value doesn't exist, so add new table
                
                If Me.ListObjects.Count = 0 Then
                    'No tables on sheet so start new table at A3
                    Set tableDestCell = Me.Range("A3")
                Else
                    'Start new table with 2 row gap below last table
                    Set ddTable = Me.ListObjects(Me.ListObjects.Count)
                    Set tableDestCell = ddTable.Range.Item(1 + ddTable.Range.Rows.Count + 2, 1)
                End If
                
                'Filter main table and copy visible rows to new table
                
                mainTable.Range.AutoFilter Field:=2, Criteria1:=Target.Value
                mainTable.Range.SpecialCells(xlVisible).Copy tableDestCell
                Set ddTable = Me.ListObjects.Add(xlSrcRange, tableDestCell.CurrentRegion, , xlYes)
                ddTable.ShowAutoFilterDropDown = False
                ddTable.ShowTotals = True
                ddTable.Name = "Table_" & Target.Value
                
            Else
            
                'Table for this dropdown value already exists, so copy to this table
                
                Set tableDestCell = ddTable.Range.Item(1, 1)
                mainTable.Range.AutoFilter Field:=2, Criteria1:=Target.Value
                rowCount = mainTable.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count + 1 'Number of visible rows + 1 for totals row
                
                Application.EnableEvents = False
                
                If rowCount > ddTable.Range.Rows.Count Then
                    'Increase number of rows in table
                    For i = 1 To rowCount - ddTable.Range.Rows.Count
                        ddTable.ListRows.Add
                    Next
                ElseIf rowCount < ddTable.Range.Rows.Count Then
                    'Decrease number of rows in table
                    For i = 1 To ddTable.Range.Rows.Count - rowCount
                        ddTable.ListRows(1).Delete
                    Next
                End If
                
                'Copy filtered rows to this table
                
                mainTable.Range.SpecialCells(xlVisible).Copy tableDestCell
                
                Application.EnableEvents = True
                
            End If
                    
        Else
            
            'The user has deleted/cleared the dropdown value.
            'Delete all existing tables
          
            While Me.ListObjects.Count
                Me.ListObjects(1).Range.Clear
            Wend
        
            Set tableDestCell = Me.Range("A3")
            
            'Filter main table column B on each data validation value and copy visible rows to this sheet, creating new tables
            
            For Each dvValueCell In Evaluate(Target.Validation.Formula1)
                mainTable.Range.AutoFilter Field:=2, Criteria1:=dvValueCell.Value
                mainTable.Range.SpecialCells(xlVisible).Copy tableDestCell
                Set ddTable = Me.ListObjects.Add(xlSrcRange, tableDestCell.CurrentRegion, , xlYes)
                ddTable.ShowAutoFilterDropDown = False
                ddTable.ShowTotals = True
                ddTable.Name = "Table_" & dvValueCell.Value
                Set tableDestCell = tableDestCell.Offset(ddTable.Range.Rows.Count + 2)
            Next
            
        End If
        
        'Clear filter on main table column B
        
        mainTable.Range.AutoFilter Field:=2

    End If
    
End Sub
You might find this macro to delete all tables on Sheet2 useful:
VBA Code:
Public Sub Delete_All_Tables()

    With Worksheets("Sheet2")
        While .ListObjects.Count
            .ListObjects(1).Delete
        Wend
    End With
    
End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,213,557
Messages
6,114,287
Members
448,562
Latest member
Flashbond

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