How To Split One Excel Sheet To Many Based On Conditions?

xlmaniac

Well-known Member
Joined
Jul 2, 2009
Messages
505
Office Version
  1. 2010
Platform
  1. Windows
Dear All,
I do have a master Sheet Named DUMP which have 10 Columns in it. The sample is as follows across A1:J9
I want to create multiple sheets from this dump sheet based on the following conditions:-

1)Number of sheets will be based on the Unique Count of DCs(Under Column:-F). Here in this scenario, the no of sheets will be 4 since there are 4 Unique count of DC Codes under Column:-F.
2)Each populated Excel Sheets will also have the same sequential Column Headers as present in the DUMP Sheet & further it should have the details only pertaining to the DC Codes.
3)Sheet Names will be based on the DC Codes(Column:-F).
4)Finally, in every populated Excel Sheet, the qty needs to be sorted on the descending order(Column:-I).

Pls help.
Input:-
DeliverySKUArticle DescriptionPGrCreated onDCShip-toSTO NumberQtyValue
q11qz25-Janaz102100
w22wx26-Janbx203200
e33ec27-Jancc304300
r44rv28-Jandd405400
t55tb29-Janae506500
y66yn30-Janar607600
u77un30-Janbt708700
i88im30-Jancy809800

Desired Result:(One Sheet for DC:-a)(Sheet Name=a)
DeliverySKUArticle DescriptionPGrCreated onDCShip-toSTO NumberQtyValue
y66yn30-Janar607600
t55tb29-Janae506500
q11qz25-Janaz102100
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
See if this will do what you want.

VBA Code:
Sub t()
Dim sh As Worksheet, c As Range
Set sh = Sheets("DUMP")
    With sh
        lr = .Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
        .Range("F1", .Cells(Rows.Count, 6).End(xlUp)).AdvancedFilter xlFilterCopy, , .Cells(lr + 2, 1), True
        For Each c In .Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Offset(1)
            If c <> "" Then
                .UsedRange.AutoFilter 6, c.Value
                Sheets.Add After:=Sheets(Sheets.Count)
                ActiveSheet.Name = c.Value
                .UsedRange.SpecialCells(xlCellTypeVisible).Copy Sheets(Sheets.Count).Range("A1")
                .AutoFilterMode = False
            End If
        Next
        .Cells(lr + 2, 1).CurrentRegion.ClearContents
    End With
End Sub
 

mart37

Well-known Member
Joined
Aug 4, 2017
Messages
1,091
Office Version
  1. 2016
Platform
  1. Windows
Maybe you can use a pivot table.
It is possible to make from one pivot table all the other sheets.
In the pivot table you place DC in the section FILTERS.
Now you can create sheets for every DC with the option: Show Report Filter Pages
 

xlmaniac

Well-known Member
Joined
Jul 2, 2009
Messages
505
Office Version
  1. 2010
Platform
  1. Windows
See if this will do what you want.

VBA Code:
Sub t()
Dim sh As Worksheet, c As Range
Set sh = Sheets("DUMP")
    With sh
        lr = .Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
        .Range("F1", .Cells(Rows.Count, 6).End(xlUp)).AdvancedFilter xlFilterCopy, , .Cells(lr + 2, 1), True
        For Each c In .Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Offset(1)
            If c <> "" Then
                .UsedRange.AutoFilter 6, c.Value
                Sheets.Add After:=Sheets(Sheets.Count)
                ActiveSheet.Name = c.Value
                .UsedRange.SpecialCells(xlCellTypeVisible).Copy Sheets(Sheets.Count).Range("A1")
                .AutoFilterMode = False
            End If
        Next
        .Cells(lr + 2, 1).CurrentRegion.ClearContents
    End With
End Sub
Thanks a lot for your time and support towards solving my issue. Really appreciate the same.:)
The solution is yielding the desired result but the qty is not sorted n the descending order in each of the sheets.(Column:-I).
Pls help to get this sorted.
Regards
Xlmaniac
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

Yep, missed that. Here it is.

VBA Code:
Sub t()
Dim sh As Worksheet, c As Range
Set sh = Sheets("DUMP")
    With sh
        lr = .Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
        .Range("F1", .Cells(Rows.Count, 6).End(xlUp)).AdvancedFilter xlFilterCopy, , .Cells(lr + 2, 1), True
        For Each c In .Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Offset(1)
            If c <> "" Then
                .UsedRange.AutoFilter 6, c.Value
                Sheets.Add After:=Sheets(Sheets.Count)
                ActiveSheet.Name = c.Value
                .UsedRange.SpecialCells(xlCellTypeVisible).Copy Sheets(Sheets.Count).Range("A1")
                Sheets(Sheets.Count).UsedRange.Sort Range("I1"), xlDescending, Header:=xlYes
                .AutoFilterMode = False
            End If
        Next
        .Cells(lr + 2, 1).CurrentRegion.ClearContents
    End With
End Sub
 
Solution

xlmaniac

Well-known Member
Joined
Jul 2, 2009
Messages
505
Office Version
  1. 2010
Platform
  1. Windows
Yep, missed that. Here it is.

VBA Code:
Sub t()
Dim sh As Worksheet, c As Range
Set sh = Sheets("DUMP")
    With sh
        lr = .Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
        .Range("F1", .Cells(Rows.Count, 6).End(xlUp)).AdvancedFilter xlFilterCopy, , .Cells(lr + 2, 1), True
        For Each c In .Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Offset(1)
            If c <> "" Then
                .UsedRange.AutoFilter 6, c.Value
                Sheets.Add After:=Sheets(Sheets.Count)
                ActiveSheet.Name = c.Value
                .UsedRange.SpecialCells(xlCellTypeVisible).Copy Sheets(Sheets.Count).Range("A1")
                Sheets(Sheets.Count).UsedRange.Sort Range("I1"), xlDescending, Header:=xlYes
                .AutoFilterMode = False
            End If
        Next
        .Cells(lr + 2, 1).CurrentRegion.ClearContents
    End With
End Sub
Absolutely amazing!!
Thanks a lot for your time & effort.
Pls accept sincere gratitude.
This will be a real time saver. :)
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
Absolutely amazing!!
Thanks a lot for your time & effort.
Pls accept sincere gratitude.
This will be a real time saver. :)
You;re Welcome,
Regards, JLG
 

Watch MrExcel Video

Forum statistics

Threads
1,129,685
Messages
5,637,809
Members
416,983
Latest member
LessThanAverageUser

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
Top