I have a excel workbook containing 20,000 rows of data. I will have to develop a macro to copy a certain range of data from that excel workbook & paste the same in another excel workbook, rename the workbook & save. Suppose one column contains certain rows with values as 1, next set of rows as value=2, another set of rows as values =3. I will have to take all the rows corresponding to value 1 and paste in the second excel workbook, rename, save && close. This process repeats for values=2 & 3. Please help in writing the Macro Code.

I call these Parse macros. On my website I've a page specifically for creating a separate workbook for each unique value in a key column of data.

The page is: Sheet1 to Workbooks

There are many similar macros on this site.

Quote:

---

Originally Posted by JBeaucaire

I call these Parse macros. On my website I've a page specifically for creating a separate workbook for each unique value in a key column of data.

The page is: Sheet1 to Workbooks

There are many similar macros on this site.

---

Hi JB,

Thanks for your help. I am a novice with macros.I still seem to have some problems with the code. I'm attaching the excel file for your reference. The filter needs to be placed in the column C ( where we have a set of rows based on this column as a primary key). Additionally I don't need to create separate worksheets. I have a template where this set of data needs to be placed from a particular range onwards. Can you please assist me with the merged code? Thanks for all your help


Cheers
Ani

1) You'll need to insert a row of titles at the top, in row1.

2) I can't seem to find the template you're referring to or any instructions on how the data would flow to that template.

Post with the template included and fill out the template manually with the first set of data from 4002756.


Also, what would these workbooks saved from this template be called? Those instructions would be needed, too. Perhaps saved as "code"+"date"

4002756 05-07-2010.xls

Quote:

---

Originally Posted by JBeaucaire

1) You'll need to insert a row of titles at the top, in row1.

2) I can't seem to find the template you're referring to or any instructions on how the data would flow to that template.

Post with the template included and fill out the template manually with the first set of data from 4002756.


Also, what would these workbooks saved from this template be called? Those instructions would be needed, too. Perhaps saved as "code"+"date"

4002756 05-07-2010.xls

---

Hi JB,

Hope you had a great weekend. You'r code to seggregate data and putting them in separate excel workbooks worked in my case. Thanks a lot. But I'm looking for additional functionalities. Let me answer your questions serialy:

1)I did'nt attach the template, as the size of the template is too large to attach. Just consider it as a template with lot of inbuilt Macro's. My Job is to put the seggregated data from the cell A20000 onwards for each distinct column value in the cell mentioned in my previous post. I will give you an example:

In the excel that I attached, column C contains repeated values. Like 4004207 is repeated in 6 rows. I need to put these 6 rows in the template which has a specific name (consider it anything.. It's hardcoded) from the location A20000 onwards. This is how data should flow.Your Macro currently is putting the data from the cell A1 onwards as it creates another spreadsheet.

2)You are almost there regarding renaming the template. I would like to add some more salt to it. It would be named as the following:

For Eg: 4004207_ANI_PR_DEN_05-07-2010.xls

Similarly for other distinct values in the first segment of the name.

I hope I could answer your questions. I can only say a big "THANK YOU" to you for all the help till now. Really appreciate it. Looking forward to your reply at the earliest.

Best Regards

Ani

Quote:

---

Originally Posted by tutan

Hi JB,

Hope you had a great weekend. You'r code to seggregate data and putting them in seperate excel workbooks worked in my case. Thanks a lot. But I'm looking for additional functionalities. Let me answer your questions serialy:

1)I did'nt attach the template, as the size of the template is too large to attach. Just consider it as a template with lot of inbuilt Macro's. My Job is to put the seggregated data from the cell A20000 onwards for each distinct column value in the cell mentioned in my previous post. I will give you an example:

In the excel that I attached, column C contains repeated values. Like 4004207 is repeated in 6 rows. I need to put these 6 rows in the template which has a specific name (consider it anything..It's hardcoded) from the location A20000 onwards. This is how data should flow.Your Macro currently is putting the data from the cell A1 onwards as it creates another spreadsheet.

2)You are almost there regarding renaming the template. I would like to add some more salt to it. It would be named as the following:

For Eg: 4004207_ANI_PR_DEN_05-07-2010.xls

Similarly for other distinct values in the first segment of the name.

I hope I could answer your questions. I can only say a big "THANK YOU" to you for all the help till now. Really appreciate it. Looking forward to your reply at the earliest.

Best Regards

Ani

---

Hi JB,

Any Inputs?

Take the macro I suggested and edit it for your working environment as best you can. Make notes in the code where you need things to act differently and post the resulting pseudo-code here, we'll complete it together.

Quote:

---

Originally Posted by JBeaucaire

Take the macro I suggested and edit it for your working environment as best you can. Make notes in the code where you need things to act differently and post the resulting pseudo-code here, we'll complete it together.

---

Hi JB,

I'm posting the code here. Thanks a lot for your prompt reply. The comments where I feel the changes needs to be done is commented in bold. Thanks a lot for your cooperation.

Sub Ani()
'Jerry Beaucaire (4/22/2010)
'Based on selected column, data is filtered to individual workbooks
'workbooks are named for the value plus today's date
Dim LR As Long, Itm As Long, MyCount As Long, vCol As Long
Dim was As Worksheet, MyArr As Variant, vTitles As String, SvPath As String

Application.ScreenUpdating = False

'Column to evaluate from, column A = 1, B = 2, etc.
vCol = 3

'Sheet with data in it
Set was = Sheets("Report1")

'Path to save files into, remember the final \
SvPath = "C:\2010\"

'Range where titles are across top of data, as string, data MUST
'have titles in this row, edit to suit your titles locale
vTitles = "A1:Z1"

'Spot bottom row of data
LR = was.Cells(ws.Rows.Count, vCol).End(xlUp).Row

'Get a temporary list of unique values from column A
was.Columns(vCol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("EE1"), Unique:=True

'Sort the temporary list
was.Columns("EE:EE").Sort Key1:=ws.Range("EE2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

'Put list into an array for looping (values cannot be the result of formulas, must be constants)
MyArr = Application.WorksheetFunction.Transpose(ws.Range(" EE2:EE" & Rows.Count).SpecialCells(xlCellTypeConstants))

'clear temporary worksheet list
was.Range("EE:EE").Clear

'Turn on the autofilter, one column only is all that is needed
was.Range(vTitles).AutoFilter

'Loop through list one value at a time
For Itm = 1 To UBound(MyArr)
was.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(Itm)

was.Range("A1:A" & LR).EntireRow.Copy
Workbooks.Add */ Here I want to paste the data in a template with the name Anirban.xls */
Range("A1").PasteSpecial xlPasteAll
Cells.Columns.AutoFit
MyCount = MyCount + Range("A" & Rows.Count).End(xlUp).Row - 1

ActiveWorkbook.SaveAs SvPath & MyArr(Itm) & Format(Date, " MM-DD-YY"), xlNormal */ Here some part of the name should be hardcoded, rest is fine*/
ActiveWorkbook.Close False

was.Range(vTitles).AutoFilter Field:=vCol
Next Itm

'Cleanup
was.AutoFilterMode = False
MsgBox "Rows with data: " & (LR - 1) & vbLf & "Rows copied to other sheets: " & MyCount & vbLf & "Hope they match!!"
Application.ScreenUpdating = True
End Sub

1) The sub should be named for what it does. Naming it after yourself results in a less-than-obvious list of macros. ;)

2) Anirban.xls is a workbook name, not a worksheet name. We need full information regarding this.

- will this workbook already be open or does it need to be opened as we make each copy? (usually we need to open it)
- what sheet name in the workbook is the actual "template"?
- what is the target cell on that sheet to paste all the rows we copied? A20000?

3) 4004207_ANI_PR_DEN_05-07-2010.xls

Does the highlighted text come from the data anywhere or is that text hardcoded and will always be the same for all filenames?

Code:

---

ActiveWorkbook.SaveAs SvPath & MyArr(Itm) & _
    "_ANI_PR_DEN_" & Format(Date, " MM-DD-YY"), xlNormal
ActiveWorkbook.Close False

---

Quote:

---

Originally Posted by JBeaucaire

1) The sub should be named for what it does. Naming it after yourself results in a less-than-obvious list of macros. ;)

2) Anirban.xls is a workbook name, not a worksheet name. We need full information regarding this.

- will this workbook already be open or does it need to be opened as we make each copy? (usually we need to open it)
- what sheet name in the workbook is the actual "template"?
- what is the target cell on that sheet to paste all the rows we copied? A20000?

3) 4004207_ANI_PR_DEN_05-07-2010.xls

Does the highlighted text come from the data anywhere or is that text hardcoded and will always be the same for all filenames?

Code:

---

ActiveWorkbook.SaveAs SvPath & MyArr(Itm) & _
    "_ANI_PR_DEN_" & Format(Date, " MM-DD-YY"), xlNormal
ActiveWorkbook.Close False

---

---

Hi JB,

Thanks a lot for your time. I will answer your queries serially.

1)Yes. I agree to you regarding the naming of Sub. Forgive my Ignorance. I will take care of it.

2)a) Yes, Anirban.xls is a workbook name with only one worksheet.
b)We need to open the workbook as we make each copy, as you mentioned.

c)As there is only one worksheet, it's the template itself.
d) Yes, you are right , we need to paste it from A20000 onwards for all the unique rows we copy.

3) Yes, this text will be hard coded & will be same for all file names.

Kindly let me know if any more info is needed.

Thanks & Best Regards
Ani

Give this a try:

Code:

---

Option Explicit

Sub FilterToTemplateAndSave()
'Jerry Beaucaire (4/22/2010)
'updated (5/16/2010)
'Based on selected column, data is filtered to individual workbooks
'workbooks are named for the value plus today's date
'This macro assumes THIS workbook is the Data sheet to filter from
Dim LR As Long, Itm As Long, MyCount As Long, vCol As Long
Dim ws As Worksheet, MyArr As Variant
Dim vTitles As String, SvPath As String

Application.ScreenUpdating = False

'Column to evaluate from, column A = 1, B = 2, etc.
    vCol = 3

'sheet with data in it to filter
    Set ws = ThisWorkbook.Sheets("Report1")

'Path to save files into, remember the final \
    SvPath = "C:\2010\"

'Range where titles are across top of data, as string, data MUST
'have titles in this row, edit to suit your titles locale
    vTitles = "A1:Z1"

'Spot bottom row of data
    LR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row

'Get a temporary list of unique values from column A
    ws.Columns(vCol).AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=ws.Range("EE1"), Unique:=True

'Sort the temporary list
    ws.Columns("EE:EE").Sort Key1:=ws.Range("EE2"), _
        Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

'Put list into an array for looping
'(values cannot be the result of formulas, must be constants)
    MyArr = Application.WorksheetFunction.Transpose(ws.Range(" EE2:EE" & _
                            Rows.Count).SpecialCells(xlCellTypeConstants))

'clear temporary list of values
    ws.Range("EE:EE").Clear

'Turn on the autofilter, one column only is all that is needed
    ws.Range(vTitles).AutoFilter

'Loop through list one value at a time
    For Itm = 1 To UBound(MyArr)
        ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(Itm)

        ws.Range("A1:A" & LR).EntireRow.Copy
        Workbooks.Open ("C:\2010\Anirban.xls")
        Range("A20000").PasteSpecial xlPasteAll
        Cells.Columns.AutoFit      'optional
        MyCount = MyCount + Range("A" & Rows.Count).End(xlUp).Row - 1

        ActiveWorkbook.SaveAs SvPath & MyArr(Itm) & _
            "_ANI_PR_DEN_" & Format(Date, " MM-DD-YY"), xlNormal
        ActiveWorkbook.Close False

        ws.Range(vTitles).AutoFilter Field:=vCol
    Next Itm

'Cleanup
    ws.AutoFilterMode = False
    MsgBox "Rows with data: " & (LR - 1) & vbLf & "Rows copied to other sheets: " _
                                            & MyCount & vbLf & "Hope they match!!"
    Application.ScreenUpdating = True
End Sub

---

Quote:

---

Originally Posted by JBeaucaire

Give this a try:

Code:

---

Option Explicit

Sub FilterToTemplateAndSave()
'Jerry Beaucaire (4/22/2010)
'updated (5/16/2010)
'Based on selected column, data is filtered to individual workbooks
'workbooks are named for the value plus today's date
'This macro assumes THIS workbook is the Data sheet to filter from
Dim LR As Long, Itm As Long, MyCount As Long, vCol As Long
Dim ws As Worksheet, MyArr As Variant
Dim vTitles As String, SvPath As String

Application.ScreenUpdating = False

'Column to evaluate from, column A = 1, B = 2, etc.
    vCol = 3

'sheet with data in it to filter
    Set ws = ThisWorkbook.Sheets("Report1")

'Path to save files into, remember the final \
    SvPath = "C:\2010\"

'Range where titles are across top of data, as string, data MUST
'have titles in this row, edit to suit your titles locale
    vTitles = "A1:Z1"

'Spot bottom row of data
    LR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row

'Get a temporary list of unique values from column A
    ws.Columns(vCol).AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=ws.Range("EE1"), Unique:=True

'Sort the temporary list
    ws.Columns("EE:EE").Sort Key1:=ws.Range("EE2"), _
        Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

'Put list into an array for looping
'(values cannot be the result of formulas, must be constants)
    MyArr = Application.WorksheetFunction.Transpose(ws.Range(" EE2:EE" & _
                            Rows.Count).SpecialCells(xlCellTypeConstants))

'clear temporary list of values
    ws.Range("EE:EE").Clear

'Turn on the autofilter, one column only is all that is needed
    ws.Range(vTitles).AutoFilter

'Loop through list one value at a time
    For Itm = 1 To UBound(MyArr)
        ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(Itm)

        ws.Range("A1:A" & LR).EntireRow.Copy
        Workbooks.Open ("C:\2010\Anirban.xls")
        Range("A20000").PasteSpecial xlPasteAll
        Cells.Columns.AutoFit      'optional
        MyCount = MyCount + Range("A" & Rows.Count).End(xlUp).Row - 1

        ActiveWorkbook.SaveAs SvPath & MyArr(Itm) & _
            "_ANI_PR_DEN_" & Format(Date, " MM-DD-YY"), xlNormal
        ActiveWorkbook.Close False

        ws.Range(vTitles).AutoFilter Field:=vCol
    Next Itm

'Cleanup
    ws.AutoFilterMode = False
    MsgBox "Rows with data: " & (LR - 1) & vbLf & "Rows copied to other sheets: " _
                                            & MyCount & vbLf & "Hope they match!!"
    Application.ScreenUpdating = True
End Sub

---

---

Hi JB,

The Macro is working fine. Thanks a Lot for your help. It's sheer magic!!

Regards

Anirban

Glad to help.

TIP: Next time, resist using that QUOTE button for all your replies, notice how all cluttered all of your posts are compared to mine? Just use the "Answer This Question" box at the bottom of this page... much cleaner.

;)

By the way, that message box that appears at the end, is it EVER right? I'd think we needed to adjust the math a little to get it to be right. Maybe this:

Code:

---

        Range("A20000").PasteSpecial xlPasteAll
        Cells.Columns.AutoFit      'optional
        MyCount = MyCount + Range("A" & Rows.Count).End(xlUp).Row - 20000

---

Or maybe - 19999?