CODEWITHSUNDEEP
c#.netexcelvba
Alex Gordon
Alex Gordon

Reputation: 60892

Solution for Dividing WorkSheet into Multiple Files with vba/excel/c#

I would like to divide a worksheet into multiple files.

I have a worksheet with about 10,000 rows. there is fancy formatting, conditional formatting, nice colors, and I want to preserve all of these attributes.

I need to divide this worksheet up.

the input would be:

+-------+----+----+----+----+
| Alex  | 45 |  6 | 23 | 56 |
| Alex  | 61 | 47 | 56 | 56 |
| Liza  | 49 | 70 | 34 | 37 |
| Alex  | 33 | 30 | 22 | 39 |
| Tommy |    | 66 | 62 | 29 |
| Liza  |    | 38 | 49 | 80 |
| Alex  | 23 | 56 | 56 | 39 |
| Liza  | 32 | 46 | 40 | 43 |
| Liza  |    | 90 | 24 | 38 |
| Tommy | 38 | 10 | 52 | 23 |
| Nancy | 35 | 36 | 23 | 25 |
+-------+----+----+----+----+

and the output would be separate files like this (please keep in mind i want to preserve all the fancy formatting, and thus the solution has work directly with excel, and not with just CSV (because csv cannot retain formatting))

end products:

+------+----+----+----+----+
|      |    |    |    |    |
| Alex | 45 |  6 | 23 | 56 |
| Alex | 61 | 47 | 56 | 56 |
| Alex | 33 | 30 | 22 | 39 |
| Alex | 23 | 56 | 56 | 39 |
+------+----+----+----+----+

and

+------+----+----+----+----+
|      |    |    |    |    |
| Liza | 49 | 70 | 34 | 37 |
| Liza |    | 38 | 49 | 80 |
| Liza | 32 | 46 | 40 | 43 |
| Liza |    | 90 | 24 | 38 |
+------+----+----+----+----+

and

+-------+----+----+----+----+
|       |    |    |    |    |
| Nancy | 35 | 36 | 23 | 25 |
+-------+----+----+----+----+

and

+-------+----+----+----+----+
|       |    |    |    |    |
| Tommy |    | 66 | 62 | 29 |
| Tommy | 38 | 10 | 52 | 23 |
+-------+----+----+----+----+

the solution can be a combination of VBA/.NET. please note that i need multiple files as outputs.

what is the quickest way to get this working? thanks so much for any input!

please note that this is excel 2007 and later

Upvotes: 1

Views: 3280

Answers (2)

pabdulin
pabdulin

Reputation: 35255

Since Excel formatting is usually a big pain in the a**, I would recommend to try a following solution:

  1. Calculate and store all the unique keys.
  2. Create a copy of a file for each key (like file_Alex.xls[x], file_Liza.xls[x] and so on).
  3. Process each file, deleting all non-key rows, thus all key entries are left. Also because you are only deleting entire rows all the formatting in file is retained.

This is very unoptimized, but also extremely simple solution. If it's a one-time job, it should do just fine.

Upvotes: 2

Moosli
Moosli

Reputation: 3285

I done this before.

You can use this code:

Option Explicit

Sub getInformations()

Dim varName As String

Application.ScreenUpdating = False
'Replace Tabelle1 with the name of your sheet where the Informations are
Worksheets("Tabelle1").Select
Worksheets("Tabelle1").Copy After:=Sheets("Tabelle1")
Sheets("Tabelle1 (2)").Select
Sheets("Tabelle1 (2)").Name = "Temp"
Do Until Range("A1").Value = vbNullString
    varName = Range("A1").Value
    Workbooks.Add
    'Change the Path where you want to save the File
    ActiveWorkbook.SaveAs ("C:\Documents and Settings\vgellhom\Desktop\" & varName & ".xls")
    'Change The Name of the Excel Workbopk to the Name of the Workbook with the Names
    Workbooks("Data.xls").Activate
    Sheets("Temp").Select
    varName = Range("A1").Value

    Do While True
        Cells.Find(What:=varName).Activate
        Range(ActiveCell.Row & ":" & ActiveCell.Row).Select
        Selection.Copy
        Workbooks(varName & ".xls").Activate
        ActiveSheet.Paste
        ActiveCell.Offset(1, 0).Activate
        'Change The Name of the Excel Workbopk to the Name of the Workbook with the Names
        Workbooks("Data.xls").Activate
        Sheets("Temp").Select
        Selection.Delete Shift:=xlUp
        If Not Cells.FindNext(After:=ActiveCell) Is Nothing Then
            Cells.Find(What:=varName).Activate
        Else
            Exit Do
        End If
    Loop
    Workbooks(varName & ".xls").Activate
    'Change the Path where you want to save the File
    Application.DisplayAlerts = False
    ActiveWorkbook.Save
    Application.DisplayAlerts = True

    Workbooks(varName & ".xls").Close
Loop
Application.DisplayAlerts = False
Sheets("Temp").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Hope that helps you...

Upvotes: 2

Related Questions