Solved

Excel macro - Sort by column values and create new excel file

Posted on 2016-09-08
6
43 Views
Last Modified: 2016-09-08
Hi All,
I have an requirement to create separate excel files based upon the unique column (id_sub) values and copy the data into new excel file.
Please find attached sample file for this. The highlighted section means those many new excel file with value as filename.
Can you please provide any reference code for this.

Thanks,
Shail
Book1.xlsx
0
Comment
Question by:Shailesh Shinde
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 2
6 Comments
 
LVL 51

Expert Comment

by:Rgonzo1971
ID: 41789388
Hi,

pls try
Sub macro()
Dim aIds As Variant
Application.ScreenUpdating = False
Set origSh = ActiveSheet
Worksheets.Add
Set myRng = Range(origSh.Range("B2"), origSh.Range("B" & Rows.Count).End(xlUp))
myRng.Copy Destination:=ActiveSheet.Range("A1")
ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
aIds = WorksheetFunction.Index(WorksheetFunction.Transpose(Range(Range("A1"), Range("A" & Rows.Count).End(xlUp)).Value), 1, 0)
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
For Each Item In aIds
    Worksheets.Copy

    Range("A1:B1").AutoFilter field:=2, Criteria1:="<>" & Item
    Set myRng = Nothing
    On Error Resume Next
    Set myRng = Range(Range("b2"), Range("b" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    Range("B1").AutoFilter
    If Not myRng Is Nothing Then
        For Idx = myRng.Areas.Count To 1 Step -1
            myRng.Areas(Idx).EntireRow.Delete Shift:=xlUp
        Next
    End If
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "/" & Item
    ActiveWorkbook.Close
Next
Application.DisplayAlerts = False
origSh.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Open in new window

Regards
0
 
LVL 3

Author Comment

by:Shailesh Shinde
ID: 41789413
Hi,
This works and output the files but show error at "origSh.Delete" line no.31 in your code.

Thanks,
Shail
0
 
LVL 3

Author Comment

by:Shailesh Shinde
ID: 41789420
Attached Error Message screenshot...
1.jpg
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 51

Accepted Solution

by:
Rgonzo1971 earned 500 total points
ID: 41789449
then try

Sub macro()
Dim aIds As Variant
Application.ScreenUpdating = False
Set origSh = ActiveSheet
Worksheets.Add
Set myRng = Range(origSh.Range("B2"), origSh.Range("B" & Rows.Count).End(xlUp))
myRng.Copy Destination:=ActiveSheet.Range("A1")
ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
aIds = WorksheetFunction.Index(WorksheetFunction.Transpose(Range(Range("A1"), Range("A" & Rows.Count).End(xlUp)).Value), 1, 0)
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
For Each Item In aIds
    Worksheets.Copy

    Range("A1:B1").AutoFilter field:=2, Criteria1:="<>" & Item
    Set myRng = Nothing
    On Error Resume Next
    Set myRng = Range(Range("b2"), Range("b" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    Range("B1").AutoFilter
    If Not myRng Is Nothing Then
        For Idx = myRng.Areas.Count To 1 Step -1
            myRng.Areas(Idx).EntireRow.Delete Shift:=xlUp
        Next
    End If
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "/" & Item
    ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
End Sub

Open in new window

0
 
LVL 31

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41789454
If you have only one sheet in the workbook, that error will be produced.
Why do you want to delete that original single sheet?
0
 
LVL 3

Author Closing Comment

by:Shailesh Shinde
ID: 41790741
Thanks, this works as required.
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

688 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question