Macro to Split 1 worksheet to Multiple Excel Files - with Name of Cell (Column).

[Jennie82]

Dear Experts in Excel,

I am making reports and facing an issues with large volumes.
The file is about 25,000 items belongs to 305 students. Each student can have datas in multiple Rows.

The Student Name are in column (L : Student as its header). I cannot manually copy data for each student manually to create a seperate file for him/her and naming the file as his/ her name.

I would like to have a Macro to help me with this.
I am quite new to VBA so I can hardly understand the previous posts on this matter . Appreciate your Support.


Best Regards,

Thu.

 

[Jennie82]

Can anyone help me on this ?

 

[DocAElstein]

…………………….

The Student Name are in column (L : Student as its header). I cannot manually copy data for each student manually to create a separate file for him/her and naming the file as his/ her name.

I would like to have a Macro to help me with this.
I am quite new to VBA so I can hardly understand the previous posts on this matter

Thu.

Hi Jennie82 Thu,
. What Threads have you checked out?. Any of these for example? These have some codes of mine which at first glance seem to do something very similar to what you want.(they actually would produce a new sheet rather than a new file for each student with his/ her name as the sheet name, but that could would be a good start point for you )

Copying a row from a worksheet to multiple new sheets depending on the word in the column
http://www.mrexcel.com/forum/excel-...-value-paste-worksheet-same-name-value-3.html
http://www.mrexcel.com/forum/excel-...her-worksheet-if-column-=-specific-value.html
http://www.mrexcel.com/forum/excel-...-into-multiple-worksheets-based-column-8.html
Copy entire row to another worksheet if column = specific value
Copying a Row Based on Coloumn Contents
VBA code for Grouping columns in excel based on certain criteria

. If you have difficulty following these Threads or have difficulty in applying the codes to your Files then you will need to post us more information to give us a clear picture of:
. 1) Your original spreadsheet (the amount of data rows shortened for clarity. Data can be made up if sensitive but should clearly show all columns and types of data)
. 2) Some examples of the new sheets as you wish the macro to make for you based on your sample data from .1)

. To give us that picture:-
. 1) we prefer you to use the various Forum Tools as indicated in my signature below. These are free add-ins that you can download.
or
. 2) Up left in the Thread editor is a table icon. Click that, create an appropriately sized table and fill it in. (To get this icon up in the Reply window you may need to click on the “Go Advanced” Button next to the Reply Button)
Or
. 3) As a last resort, drop a file off to us. For example send over this free thing: Box Net,
Remember to select Share after uploading and give us the link they provide.

. If you still need help after checking out those threads, and give us a clear picture as described above, and no one else picks up the thread I will take a look at it tomorrow for you.

Alan
P.s. Welcome to the Board!

 

[JLGWhiz]

Hi Jennie82, I tried to make this as painless as possible.
To install this code, first save you workbook with the student names as a macro enabled workbook. Make sure your macro security settings allow you to use VBA. Copy this code to your standard code module 1. To access the code module, press Alt + F11 and the VB Editor will open. If the large Pane is dark, click 'Insert' on the VB editor menu bar. Click 'Module' and the pane should brighten. Copy the code into that pane. Instructions for running the code are at the bottom of this post.

Sub makeStudenRecord()
Dim sh As Worksheet, lr As Long, rng As Range, c As Range, lc As Long
Set sh = Sheets(1)
lr = sh.Cells(Rows.Count, "L").End(xlUp).Row
lc = sh.Cells.Find("*", , xlFormulas, xlPart, xlByColumns, xlPrevious).Column
sh.Range("L2:L" & lr).AdvancedFilter xlFilterCopy, , sh.Range("A" & lr + 2), True
Set rng = sh.Range("A" & lr + 3, sh.Cells(Rows.Count, 1).End(xlUp))
    For Each c In rng
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = c.Value
        sh.Range("A1", sh.Cells(lr, lc)).AutoFilter 12, c.Value
        sh.Range("A1", sh.Cells(lr, lc)).SpecialCells(xlCellTypeVisible).Copy ActiveSheet.Range("A1")
        sh.AutoFilterMode = False
    Next
sh.Range("A" & lr + 2, sh.Cells(Rows.Count, 1).End(xlUp)).Delete
End Sub

This code will not create new workbooks. It does create individual sheets for each student and leaves the original sheet intact for your disposition.

 

[Jennie82]

Hi JLGWhiz , thanks a million. Your code is working well to create WorkSheets but if it can turn to create new workbook it will be more wonderful. As the data needs to be confidential for each student.
Appreciate if you can help further.

Hi DocAElstein,
I have checked out many of the topics but cannot find what can help. JLGWhiz can help my case but I would like to have it by workbook, it will be better.

Thu.

 

[DocAElstein]

Hi Thu,
. JLGWhiz is a pro and has got you a super code, I guess he can / will modify it for you to create new Files rather than sheets.
. I am still learning VBA by answering these threads and when alternative solutions are given I find the thread a particularly useful one for me to learn from. So I would be keen to give it a try, that is to say modify my existing codes to your application. (My codes are basically the same as that from JLGWhiz ). But as a beginner I find it difficult working blind as it were with no test data. It would help me a lot if you could drop me off sample data as I asked for, ideally now including the code that is working for you from JLGWhiz. (As mentioned shortened data and change any confidential names etc.)
. If you are not familiar yet with the Forum Tools and do not like the file sharing option then you can attach a file to an Email to me. If you PM (Private Message) me then I will give you my E-mail address. (To PM me click on my name under my House Picture when you are logged – in. A Private Message option is then given and the rest should be obvious)

Alan

………………………………..

Hi JLGWhiz

…. I tried to make this as painless as possible.
To install this code, …………………...

. Another great code Variation from You for me to learn from. Thanks.
. I hope to get good enough one day to write a working code so quickly, and that without test data!!
Alan

 

[DocAElstein]

Hi JLGWhiz



. Another great code Variation from You for me to learn from. Thanks.
. I hope to get good enough one day to write a working code so quickly, and that without test data!!
Alan

Hi JLGWhiz,
. I have gone through and almost understand your code. ( I have a modified version of your code working for all my previous Threads with a similar requirement. In particular I have learnt a new way to make a temporary unique list ( for the student names in this case ). Great. )
. A couple of minor Points / questions.
.
. 1) I apologies if I am in error here, but I think in the ( I agree unlikely ) case that the first name ( in cell “L2” ) is only given once then that sheet will be missed out. I think that is because for the AdvancedFilter the first cell is taken as a heading? Modifying your
sh.Range("L2:L" & lr).AdvancedFilter
to
sh.Range("L1:L" & lr).AdvancedFilter
overcomes this I think?
. Can you confirm that? It is a very minor point and the OP did say that “Each student can have datas in multiple Rows. „. But confirming this would help me in understanding the code. ( I note you do “skip over” this heading by choosing +3 rather than +2 in the appropriate code line. But in the case that the first student name is only given once in cell “L2”, then this name and sheet would be missed out )

. 2) I could not quite google out a clear understanding of the Advanced filter method. In particular one optional argument is troubling me. It is second ( optional) argument CriteriaRange:=
. I note you have missed it out. I do not understand the typical explanation “……. If this argument is omitted, there are no criteria.” By trial and error I find I can give any range for this argument and the code appears to work the same?

Thanks,
Alan

 

[JLGWhiz]

Managing 350 individual files is more cumbersome than managing one file with 350 worksheets, but it is your choice and your file space. Here is the code for the workbooks.

Sub makeStudenRecord()
Dim wb As Workbook, sh As Worksheet, ssh As Worksheet, lr As Long, rng As Range, c As Range, lc As Long
Set sh = Sheets(1)
lr = sh.Cells(Rows.Count, "L").End(xlUp).Row
lc = sh.Cells.Find("*", , xlFormulas, xlPart, xlByColumns, xlPrevious).Column
sh.Range("L2:L" & lr).AdvancedFilter xlFilterCopy, , sh.Range("A" & lr + 2), True
Set rng = sh.Range("A" & lr + 3, sh.Cells(Rows.Count, 1).End(xlUp))
    For Each c In rng
        Set wb = Workbooks.Add
        Set ssh = wb.Sheets(1)
        ssh.Name = c.Value
        sh.Range("A1", sh.Cells(lr, lc)).AutoFilter 12, c.Value
        sh.Range("A1", sh.Cells(lr, lc)).SpecialCells(xlCellTypeVisible).Copy ssh.Range("A1")
        sh.AutoFilterMode = False
    wb.SaveAs ThisWorkbook.Path & "\" & c.Value & ".xlsx"
    wb.Close False
    Set wb = Nothing
    Next
sh.Range("A" & lr + 2, sh.Cells(Rows.Count, 1).End(xlUp)).Delete
End Sub

 

[JLGWhiz]

@DocAElstein, The Advanced filter, as well as the autofilter, uses the first row of the designated range as a header. The range is then altered by one row at the top to eliminate the header from the data we want to work with. Both the Advanced Filter and the AutoFilter methods are defined in the VBA help files. The on line help also has forum examples from which you can get additional information.

 

[Jennie82]

Hi JLGWhiz, it is really lucky that you can read my post and help. I understand the request is quite funny for 305 files but it is a real request I received. Thank you for your help. Many people can find this interesting .