How to copy multiple rows, where cells have specific value.

[Alex T]

Good day,

I have a file "Customer List" that contains multiple customers in it and is being generated every week. This file has Columns A to K and can have different number or rows every time. One of the Columns (Customer_Name) is always constant.

I am looking for a VBA script that will allow me to scan through the entire file, search for the (Customer_Name) one at a time, copy all records for that client and paste it into the new File, then move to the next (Customer_Name) and do the same. So at the end i will have lets say 10 files with 10 different (Customer_Name) data in them.

Any help would be greatly appreciated.

Thank you.

 

[Peter_SSs]

Try this. It may possibly require a bit more tweaking depending on just what you have in the sheet and what version of Excel you are using.

It creates the new files in the same folder as your original sheet that contains the code. The code currently over-writes any file with the same name. If you don't want that to happen automatically, remove the two lines indicated towards the bottom of the code.

Probably a good idea for testing would be to
- create a new folder,
- make a copy of your workbook in that folder,
- add my code to that copy of the workbook and then
- run CreateCustomerSheets_2

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> CreateCustomerSheets_2()<br>    <SPAN style="color:#00007F">Dim</SPAN> wsMain <SPAN style="color:#00007F">As</SPAN> Worksheet<br>    <SPAN style="color:#00007F">Dim</SPAN> CustList()<br>    <SPAN style="color:#00007F">Dim</SPAN> n <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> myPath <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, fName <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>    <br>    <SPAN style="color:#00007F">Const</SPAN> CustCol <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN> = 2   <SPAN style="color:#007F00">'<-- Your customer column (2 = B)</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> wsMain = Sheets("Main") <SPAN style="color:#007F00">'<-- Use your main sheet name</SPAN><br><br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    <SPAN style="color:#00007F">With</SPAN> wsMain<br>        .Columns(CustCol).AdvancedFilter Action:=xlFilterCopy, _<br>            CopyToRange:=.Range("M1"), Unique:=<SPAN style="color:#00007F">True</SPAN><br>        CustList = .Range("M2", .Range("M2").End(xlDown)).Value<br>        .Columns("M").ClearContents<br>        myPath = .Parent.Path & "\"<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    <SPAN style="color:#00007F">For</SPAN> n = 1 <SPAN style="color:#00007F">To</SPAN> <SPAN style="color:#00007F">UBound</SPAN>(CustList, 1)<br>        fName = CleanName(CustList(n, 1))<br>        wsMain.Copy<br>        <SPAN style="color:#00007F">With</SPAN> ActiveSheet<br>            .Name = fName<br>            <SPAN style="color:#00007F">With</SPAN> .Columns(CustCol).Resize(.UsedRange.Rows.Count)<br>                .AutoFilter Field:=1, Criteria1:="<>" & CustList(n, 1)<br>                .Offset(1).EntireRow.Delete<br>                .AutoFilter<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>        Application.DisplayAlerts = <SPAN style="color:#00007F">False</SPAN> <SPAN style="color:#007F00">'<-Remove line if overwrite warning required</SPAN><br>        ActiveWorkbook.SaveAs Filename:=myPath & fName, FileFormat:=xlNormal<br>        ActiveWorkbook.Close<br>        Application.DisplayAlerts = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'<-Remove line if you remove the one above</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> n<br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br>    MsgBox "Finished"<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><br><SPAN style="color:#00007F">Function</SPAN> CleanName(<SPAN style="color:#00007F">ByVal</SPAN> s <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>    s = Replace(Replace(Replace(s, "[", "_"), "/", "_"), "\", "_")<br>    s = Replace(Replace(Replace(s, ":", "_"), "*", "_"), "?", "_")<br>    s = Replace(Replace(Replace(s, "<", "_"), ">", "_"), "]", "_")<br>    CleanName = Left(s, 31)<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Function</SPAN></FONT>

 

[Alex T]

Hi guys,

I cant say Thank You enough to all of you. mrnacar - With little tweaks your code works Exactly as i needed. Thank you again for your knowledge and time you spent on these questions.

 

[Peter_SSs]

Alex T

I've moved your new question to a new thread here. Note my comments in post #2 of that new thread.