?
Solved

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

Posted on 2016-09-08
6
Medium Priority
?
45 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 52

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
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
LVL 52

Accepted Solution

by:
Rgonzo1971 earned 2000 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 32

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

Enroll in August's Course of the Month

August's CompTIA IT Fundamentals course includes 19 hours of basic computer principle modules and prepares you for the certification exam. It's free for Premium Members, Team Accounts, and Qualified Experts!

Question has a verified solution.

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

In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
This article describes how you can use Custom Document Properties to store settings and other information in your workbook so that they will be available the next time you open the workbook.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

765 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