Solved

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

Posted on 2016-09-08
6
34 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
  • 3
  • 2
6 Comments
 
LVL 49

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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 49

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 28

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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Over the years I have built up my own little library of code snippets that I refer to when programming or writing a script.  Many of these have come from the web or adaptations from snippets I find on the Web.  Periodically I add to them when I come…
Not long ago I saw a question in the VB Script forum that I thought would not take much time. You can read that question (Question ID  (http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28455246.html)28455246) Here (http…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

910 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

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now