Create Workbooks from a data list using filters to select names

[MikeXYZ7]

Hi

I have searched for answers to this but couldn't find any. I have a list which consists of different products eg blue, red and green. There are around 10 columns (of extra info) and about 1000 lines and this info changes weekly. What i want to do is automate the process of filtering by "colour" and copying the range (10 columns by however many rows) and in doing so create 3 files....blue.xlsm, red.xlsm & green.xlsm.

The bit i am getting stuck on the most is how to automatically select the range for each filter of red, blue and green. I am sorting the colour column, then filtering to select red, copy range and paste as values in new workbook, then repeating the process for blue and green.

The trouble is that the number of rows varies and the start point row eg A column needs to be the first line of the new data.

	A	B	C	D	E	F	G	H	I
1	DATE	NAME	TIME	COLOUR	WEIGHT	HEIGHT	DEPTH	LENGTH	GRADE
2	1.9	Dave	0800	blue	100	100	100	100	1
3	2.9	John	0800	blue	100	100	100	100	1
4	1.9	dave	0800	red	50	50	50	50	2
5	3.9	steve	0800	red	60	60	60	60	1
6	3.9	dior	0800	green	44	55	66	66	1
7	5.9	cath	0900	red	22	33	22	22	2
8	1.9	sarah	0900	green	56	34	34	34	3
9	4.9	james	0900	blue	34	12	12	12	1

<tbody>
</tbody>

Please can one of you clever people help me out as i'm really stuck on this. End result should be 3 files that contain the rows relating to the colour eg red, blue and green.

Really would appreciate your help and i hope my explanation makes sense?

Best wishes

Mike

 

[Norie]

Mike

If you are filtering you shouldn't need to sort.

You should just be able to filter for each unique value in the COLOUR column one by one and copy the visible cells for each colour to the relevant workbook.

Getting the range to copy/filter should be straightforward, it's the current region that contains A1 (assuming your data/headers in A1 of course).

 

[MikeXYZ7]

Mike

If you are filtering you shouldn't need to sort.

You should just be able to filter for each unique value in the COLOUR column one by one and copy the visible cells for each colour to the relevant workbook.

Getting the range to copy/filter should be straightforward, it's the current region that contains A1 (assuming your data/headers in A1 of course).

Hi Norie

Thanks for the response. What you are saying makes sense. It sounds like the beginning of my range is good eg A1: but I'm not sure how to automatically adjust for the number of rows after the filter? My end range will be something like J?? eg A1:J?? where ?? relates to the last row.

Can you help me with this part of the code please? It's late - i'll try and post the code i have so far tomorrow.

Thanks again

mike

 

[Norie]

Mike

Something like this could be used to get the range including the header and the data.

Dim rngData As Range

    Set rngData = Range("A1").CurrentRegion

That range could then be filtered as required and the results of each filter copied to the relevant workbook.

 

[MikeXYZ7]

Hi Norie
That was remarkably simple and worked brilliantly. Thank you for your help with this. Very happy.
Kind regards
Mike

 

[MikeXYZ7]

One thing I have just noticed is that I am inadvertently copying the header rows too. Rows 1-4 contain info and headers (row 4) that i do not want to copy. I set the ranges for all macro references to A5 as a start point but it copies from row A3.

How do i get around this?

Kind regards

Mike

 

[MikeXYZ7]

One thing I have just noticed is that I am inadvertently copying the header rows too. Rows 1-4 contain info and headers (row 4) that i do not want to copy. I set the ranges for all macro references to A5 as a start point but it copies from row A3.

How do i get around this?

Kind regards

Mike

Code here (not in relation to table i posted earlier but i think you can still get the gist of what i am trying to do?)

Sub FilterCopyRangePasteFile5()
 
Dim rngData As Range
 
'select range and then filter by colour (headers are in rows 3 and 4)
 
    ActiveSheet.Range("$A$5:$BE$1000").AutoFilter Field:=7, Criteria1:="Blue"
   
'select range
 
    Set rngData = Range("A5").CurrentRegion
    rngData.Select
    Selection.Copy
   
'Open Target File
   
    Workbooks.Open Filename:= _
        "C:\BLUE.xlsx"
 
'put cursor at A4 in new file (haven’t specified sheet yet)
 
    Range("A4").Select
   
'paste copied cells here (as values)
 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
'save & close workbook
   
    ActiveWorkbook.Save
    ActiveWindow.Close
 
End Sub

 

[MikeXYZ7]

I've just posted the code...but mods need to approve it first...

 

[Joe4]

It has been approved and can be seen up in post 7.