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

[xlmaniac]

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:-

Delivery	SKU	Article Description	PGr	Created on	DC	Ship-to	STO Number	Qty	Value
q	1	1q	z	25-Jan	a	z	10	2	100
w	2	2w	x	26-Jan	b	x	20	3	200
e	3	3e	c	27-Jan	c	c	30	4	300
r	4	4r	v	28-Jan	d	d	40	5	400
t	5	5t	b	29-Jan	a	e	50	6	500
y	6	6y	n	30-Jan	a	r	60	7	600
u	7	7u	n	30-Jan	b	t	70	8	700
i	8	8i	m	30-Jan	c	y	80	9	800

Desired ResultOne Sheet for DC:-a)(Sheet Name=a)

Delivery	SKU	Article Description	PGr	Created on	DC	Ship-to	STO Number	Qty	Value
y	6	6y	n	30-Jan	a	r	60	7	600
t	5	5t	b	29-Jan	a	e	50	6	500
q	1	1q	z	25-Jan	a	z	10	2	100

 

[JLGWhiz]

See if this will do what you want.

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]

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]

See if this will do what you want.

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]

Yep, missed that. Here it is.

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

 

[xlmaniac]

Yep, missed that. Here it is.

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]

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