Splitting Worksheet Into Multiple Workbooks

Hi all,

I need to split my worksheet into multiple workbooks based on column B and name the new workbook according to column B. For exampleCapture.JPG
and save as SM-30403-0.xlsx and so on.

I know there are many such examples around but my attempt to adapt from the examples gave me errors "runtime error 1004 - the file could not be accessed" trying to write the new workbooks. I would appreciate any help and advice as I am going round in circles getting nowhere.

Your problem is that you copy your data into the last column. Reading the data includes a carriage return and this is a character that cannot be handled.
Copy your data to .Columns.Count - 1 and read it from there and it will work

cheers

Originally Posted by gue2013

Your problem is that you copy your data into the last column. Reading the data includes a carriage return and this is a character that cannot be handled.
Copy your data to .Columns.Count - 1 and read it from there and it will work

cheers

Hi gue2013,

Thank you for pointing out my errors. You are spot on. I have another workbook having similar codes which I noticed data in my last column even though it managed to split the workbook into multiple worksheets. Could you enlighten me about this >> "Copy your data to .Columns.Count - 1" as I do not quite understand what you meant.

Cheers

(removed as too late)

Originally Posted by sintek

Oops I only now noticed new workbooks...
Your file has an issue though where column B has carriage gap | Multi-line in cell...Hence the error to save workbook...
See this upload with new add workbook code...

Hi Sintek,
Thank you! It works exactly what I needed.. Appreciate that you pointed out the column B (carriage gap/Multi-line) error. This worksheet was converted to excel from another format, hence the formatting problem for me.

Hi all,
As pointed out by gue2013 and sintek, there is a problem with my data has (carriage gap/Multi-line) error. I tried to remove the (carriage gap/Multi-line) in the data with vba but I keep getting runtime error 1004 when I try to split the workbook.

I would appreciate if someone help me add codes into the macro to remove the (carriage gap/Multi-line) so it can run without runtime error?

you have 2 problems in your code
1) you have to remove all special characters in your data (carriage return & line feeds, both are sometimes available. First you have to remove these chars (replace with "") and then you can select the region to store in an array ("Data")
2) your loop is wrong. you first have to find all keys for your dictionary and then you can go through all keys and filter your data.

I attached a working version

cheers

Hi Sintek,
Thank you very much for your quick response to my request. When I run the codes, I no longer get runtime error 1004 as it has taken care of the (carriage return & line feeds).
But when I run the codes, it prompts me if I want to replace the split workbooks. If I choose replace, and for example (SM-3080163-0), there should be 7 rows in the newly created workbook, the final workbook I got only has 3 rows. So I guess maybe during filtering, it is splitting "SM-3080163-0" and "SM-3080163-0 " different workbooks and writing into same file name. Any advise on this? Cheers.

Originally Posted by sintek

Post not allowing me to add the code....

Hi Sintek !

Just add a $ character or a space to one of your Replace statement …

As it well works on my side :

PHP Code: 

            File = ThisWorkbook.Path & "\" & Replace$(Replace(Data(i, 2), vbCr, ""), vbLf, ""): Dict.Add Data(i, 2), 1 


Or :

PHP Code: 

            File = ThisWorkbook.Path & "\" & Replace( Replace(Data(i, 2), vbCr, ""), vbLf, ""): Dict.Add Data(i, 2), 1 


You did something wrong as that's your post #11 code :

Sub INVOICES_SPLIT()
Dim Data, File As String, Dict As Object, i As Long
Application.ScreenUpdating = False
Set Dict = CreateObject("scripting.dictionary")
With Sheet1
    Data = .Cells(1).CurrentRegion
    For i = 2 To UBound(Data)
        If Not Dict.exists(Data(i, 2)) Then
            File = ThisWorkbook.Path & "\" & Replace$(Replace(Data(i, 2), vbCr, ""), vbLf, ""): Dict.Add Data(i, 2), 1
            With .Cells(1).CurrentRegion
                .AutoFilter 2, Data(i, 2)
                .SpecialCells(12).Copy
                With Workbooks.Add
                    .Sheets(1).Range("A1").PasteSpecial xlPasteAll
                    .SaveAs File & ".xlsx"
                    .Close False
                End With
                .AutoFilter
            End With
        End If
    Next i
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Hi guys,
Thanks a lot. It is finally running as I wish. Saving me lots of time from having to trial and error. Am trying to learn from all these discussions here. Cheers.....

Exactly the same for your post #14 code : just well amending each double Replace statement …

Sub INVOICES_SPLIT()
Dim Data, File As String, Dict As Object, i As Long
Application.ScreenUpdating = False
Set Dict = CreateObject("scripting.dictionary")
With Sheet1
    Data = .Cells(1).CurrentRegion
    For i = 2 To UBound(Data)
        If Not Dict.exists(Replace( Replace(Data(i, 2), vbCr, ""), vbLf, "")) Then
            File = ThisWorkbook.Path & "\" & Replace( Replace(Data(i, 2), vbCr, ""), vbLf, ""): Dict.Add Replace( Replace(Data(i, 2), vbCr, ""), vbLf, ""), 1
            With .Cells(1).CurrentRegion
                .AutoFilter 2, Replace( Replace(Data(i, 2), vbCr, ""), vbLf, "")
                .SpecialCells(12).Copy
                With Workbooks.Add
                    .Sheets(1).Range("A1").PasteSpecial xlPasteAll
                    .SaveAs File & ".xlsx"
                    .Close False
                End With
                .AutoFilter
            End With
        End If
    Next i
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub