Macro to extract data into seperate workbooks

[Kim B]

HI all. This has two parts.

This data is pulled down in a group format. I have given 1 line under each category for this scenario. It has merged cells as well. I have expanded the grouping from row 8 down. Columns A-K are merged cells. I would think auto fit and deleting of columns would come first then extract what's left would be easier but whichever order works best is fine.

1. Need to extract each location to it's own workbook (locations all have cutomer group at the end of their names. Everything under a location goes with that location until the next location is listed, and
2. auto fit columns and delete columns N,P,Q,R,T so leaving O,Q,S,U.

Thank you for your help.

Customer Dump.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U
1		Run Date: 5/4/2024 1:44:53 PM											Page #: 1
2
3						Requested Ship Date Range: x/xx/xxxx-x/xx/xxxx
4
5
6
7	Item #		External Item #		Pack Size		Item Desc				Type	Item Group		Order Qty Case	Unit or LB Ordered	Ship Qty Case	Unit or LB Ship	Ship Var - Cases	Ship Var - Unit/Lbs	Case Fill %	Unit or LB Fill Rate
8	ABC Location 1 Customer Group													8,686	23,386	8,604	23,256	82	130	99.06%	99.44%
9	Deli													6,186	6,186	6,152	6,152	34	34	99.45%	99.45%
10	XXX		XXXX		XXXOZ		XXXX				Deli	FG-ENT		169	169	169	169	0	0	100.00%	100.00%
11	Produce													2,500	17,200	2,452	17,104	48	96	98.08%	99.44%
12	ABC Location 2 Customer Group													5,822	19,186	5,756	19,046	66	140	98.87%	99.27%
13	Deli													3,674	3,674	3,674	3,674	0	0	100.00%	100.00%
14	Produce													2,148	15,512	2,082	15,372	66	140	96.93%	99.10%
15	XXX		XXXX		XXXOZ		XXXX				Produce	FG-MAP		36	216	36	216	0	0	100.00%	100.00%
16	DEF Location 1 Customer Group													11,265	29,169	11,217	29,073	48	96	99.57%	99.67%
17	Deli													8,397	8,397	8,397	8,397	0	0	100.00%	100.00%
18	XXX		XXXX		XXXOZ		XXXX				Deli	FG-GRNSAL		59	59	59	59	0	0	100.00%	100.00%
19	Produce													2,868	20,772	2,820	20,676	48	96	98.33%	99.54%
20	XXX		XXXX		XXXOZ		XXXX				Produce	FG-VEG		36	216	36	216	0	0	100.00%	100.00%
21	DEF Location 2 Customer Group													17,703	37,107	17,379	36,651	324	456	98.17%	98.77%
22	Deli													14,463	14,463	14,271	14,271	192	192	98.67%	98.67%
23	XXX		XXXX		XXXOZ		XXXX				Deli	FG-GRNSAL		111	111	105	105	6	6	94.59%	94.59%
24	Produce													3,240	22,644	3,108	22,380	132	264	95.93%	98.83%
25	Report Total													43,476	108,848	42,956	108,026	520	822	98.80%	99.24%
CustomerFillRateBySKU_V2

 

[mumps]

First of all, you should avoid merging cells at all cost because they almost always cause problems for macros. I would suggest that you re-design you data so that there are no merged cells and post the revised sheet. As well, make sure that the data you post is much more representative of what your actual data looks like. You can de-sensitize any confidential data if necessary.

 

[rlv01]

First of all, you should avoid merging cells at all cost because they almost always cause problems for macros

This.

 

[Kim B]

The report dumps like that. After unmerging the cells to be kept are H,J,L,N. I have highlighted them. Some locations will only have one subsection, Deli. Some might have two or three. The split takes place at the next location.

Customer Dump.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Run Date: 5/4/2024 1:44:53 PM	Page #: 1
2	Requested Ship Date Range: x/xx/xxxx-x/xx/xxxx
3
4
5
6
7	Item #	External Item #	Pack Size	Item Desc	Type	Item Group	Order Qty Case	Unit or LB Ordered	Ship Qty Case	Unit or LB Ship	Ship Var - Cases	Ship Var - Unit/Lbs	Case Fill %	Unit or LB Fill Rate
8	ABC Location 1 Customer Group						8,686	23,386	8,604	23,256	82	130	99.06%	99.44%
9	Deli						6,186	6,186	6,152	6,152	34	34	99.45%	99.45%
10	12345	42132	5oz	Roast Beef	Deli	FG-ENT	169	169	169	169	0	0	100.00%	100.00%
11	ABC Location 2 Customer Group						5,822	19,186	5,756	19,046	66	140	98.87%	99.27%
12	Produce						2,148	15,512	2,082	15,372	66	140	96.93%	99.10%
13	4562	96520	16OZ	Veg Mix	Produce	FG-MAP	36	216	36	216	0	0	100.00%	100.00%
14	DEF Location 1 Customer Group						11,265	29,169	11,217	29,073	48	96	99.57%	99.67%
15	Deli						8,397	8,397	8,397	8,397	0	0	100.00%	100.00%
16	8523	73256	8OZ	Salad	Deli	FG-GRNSAL	59	59	59	59	0	0	100.00%	100.00%
17	Produce						2,868	20,772	2,820	20,676	48	96	98.33%	99.54%
18	5478	9756	6OZ	Broccoli	Produce	FG-VEG	36	216	36	216	0	0	100.00%	100.00%
19	DEF Location 2 Customer Group						17,703	37,107	17,379	36,651	324	456	98.17%	98.77%
20	Deli						14,463	14,463	14,271	14,271	192	192	98.67%	98.67%
21	2354	716	5.5	Ceasar	Deli	FG-GRNSAL	111	111	105	105	6	6	94.59%	94.59%
22	Produce						3,240	22,644	3,108	22,380	132	264	95.93%	98.83%
23	Report Total						43,476	108,848	42,956	108,026	520	822	98.80%	99.24%
CustomerFillRateBySKU_V2

 

[mumps]

Try:

Sub CreateWorkbooks()
    Application.ScreenUpdating = False
    Dim lRow As Long, fnd As Range, fnd2 As Range, sAddr As String, srcWS As Worksheet
    Set srcWS = Sheets("CustomerFillRateBySKU_V2")
    With srcWS
        lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        Set fnd = .Range("A:A").Find("Customer Group", LookIn:=xlValues, LookAt:=xlPart)
        If Not fnd Is Nothing Then
            sAddr = fnd.Address
            Do
                Set fnd2 = .Range("A" & fnd.Row + 1 & ":A" & lRow - 1).Find("Customer Group", LookIn:=xlValues, LookAt:=xlPart)
                If Not fnd2 Is Nothing Then
                    Workbooks.Add
                    Application.Union(.Range("H7"), .Range("J7"), .Range("L7"), .Range("N7")).Copy Range("A1")
                    Application.Union(.Range("H" & fnd.Row & ":H" & fnd2.Row - 1), .Range("J" & fnd.Row & ":J" & fnd2.Row - 1), .Range("L" & fnd.Row & ":L" & fnd2.Row - 1), .Range("N" & fnd.Row & ":N" & fnd2.Row - 1)).Copy Range("A2")
                    Columns.AutoFit
                    ActiveSheet.Name = Trim(Split(.Range("A" & fnd.Row), "Customer")(0))
                Else
                    Workbooks.Add
                    Application.Union(.Range("H7"), .Range("J7"), .Range("L7"), .Range("N7")).Copy Range("A1")
                    Application.Union(.Range("H" & fnd.Row & ":H" & lRow - 1), .Range("J" & fnd.Row & ":J" & lRow - 1), .Range("L" & fnd.Row & ":L" & lRow - 1), .Range("N" & fnd.Row & ":N" & lRow - 1)).Copy Range("A2")
                    Columns.AutoFit
                    ActiveSheet.Name = Trim(Split(.Range("A" & fnd.Row), "Customer")(0))
                End If
                Set fnd = .Range("A:A").FindNext(fnd)
            Loop While fnd.Address <> sAddr
            sAddr = ""
        End If
    End With
    Application.ScreenUpdating = True
End Sub

 

[Kim B]

Works in that it pulls each location to it's own sheet but rows A-G are not populating so it is just showing numbers no descriptions

This is what the data really looks like. I don't hve XL2BB here sorry

 

[Burrgogi]

You're getting that undesired results because the script provided by mumps searches for "customer group" within column A. That string does not exist in your original workbook. According to the latest screenshot you posted, it shows "ABC LOCATION 1 CHESTER Customer". (The word "Group" is completely absent). It is definitely not the same as what you posted at the top of the thread originally. This is why mumps asked you to repost the data much more representative of what your actual data looks like.

If you're sure that each location has the word "Customer" somewhere in the title, this should work:

From line # 6 in the script that mumps gave you above:

Set fnd = .Range("A:A").Find("Customer Group", LookIn:=xlValues, LookAt:=xlPart)

change to this:

Set fnd = .Range("A:A").Find("Customer", LookIn:=xlValues, LookAt:=xlPart)

You just simply need to search for "Customer" instead of "Customer Group". You could also search for "Location" instead. Whatever word(s) you decide to choose, it must be contained somewhere in location name for ALL locations for the script to work.

 

[Kim B]

"group" is there, column wasn't big enough. But I changed the code anyway and it is still not populating the details in rows A-G

 

[Burrgogi]

nevermind. I just tested mumps code myself and there seems to be something missing.

 

[Burrgogi]

I took mumps code above and revised it a little bit. It works fine on my end. Try this:

Sub CreateWorkbooks_v2()
    Application.ScreenUpdating = False
    Dim lRow As Long, fnd As Range, fnd2 As Range, sAddr As String, srcWS As Worksheet
    Set srcWS = Sheets("CustomerFillRateBySKU_V2")
    With srcWS
        lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        Set fnd = .Range("A:A").Find("Location", LookIn:=xlValues, LookAt:=xlPart)
        If Not fnd Is Nothing Then
            sAddr = fnd.Address
            Do
                Set fnd2 = .Range("A" & fnd.Row + 1 & ":A" & lRow - 1).Find("Location", LookIn:=xlValues, LookAt:=xlPart)
                If Not fnd2 Is Nothing Then
                    Workbooks.Add
                    Application.Union(.Range("A7"), .Range("H7"), .Range("J7"), .Range("L7"), .Range("N7")).Copy Range("A1")
                    Application.Union(.Range("A" & fnd.Row & ":A" & fnd2.Row - 1), .Range("H" & fnd.Row & ":H" & fnd2.Row - 1), .Range("J" & fnd.Row & ":J" & fnd2.Row - 1), .Range("L" & fnd.Row & ":L" & fnd2.Row - 1), .Range("N" & fnd.Row & ":N" & fnd2.Row - 1)).Copy Range("A2")
                    Columns.AutoFit
                    ActiveSheet.Name = Trim(Split(.Range("A" & fnd.Row), "Customer")(0))
                Else
                    Workbooks.Add
                    Application.Union(.Range("A7"), .Range("H7"), .Range("J7"), .Range("L7"), .Range("N7")).Copy Range("A1")
                    Application.Union(.Range("A" & fnd.Row & ":A" & lRow - 1), .Range("H" & fnd.Row & ":H" & lRow - 1), .Range("J" & fnd.Row & ":J" & lRow - 1), .Range("L" & fnd.Row & ":L" & lRow - 1), .Range("N" & fnd.Row & ":N" & lRow - 1)).Copy Range("A2")
                    Columns.AutoFit
                    ActiveSheet.Name = Trim(Split(.Range("A" & fnd.Row), "Customer")(0))
                End If
                Set fnd = .Range("A:A").FindNext(fnd)
            Loop While fnd.Address <> sAddr
            sAddr = ""
        End If
    End With

Just a quick note: I used "Location" instead of "Customer Group" as the keyword search. Either one will work as long that word (or words) appears in ALL of the various location names.