Split Excel file down based on value in column

[EmilyNL]

Hi all

I have a file with 22.000 lines. They contain our stock codes plus their suppliers (plus some more information but not relevant for this thread). I want to create a separate excel file (or CSV, whatever I can get) for each supplier as there are over 300 suppliers.

I suppose someone with macro skills would be able to do this? So I know how to start recording and stop recording and enter the shortcut, how far can I get with this?

 

[Fluff]

Hi & welcome to the board.

I think you'll struggle to record a macro for this, but if you can answer the following I'll have a look at it.
1) What is the name of sheet containing the data?
2) What column holds the supplier name?
3) Do you have a header in row, with data starting in A2? If not where is your data?
4) Do you want the new files saved to the same directory as the original file?

 

[EmilyNL]

Hi & welcome to the board.

I think you'll struggle to record a macro for this, but if you can answer the following I'll have a look at it.
1) What is the name of sheet containing the data?
2) What column holds the supplier name?
3) Do you have a header in row, with data starting in A2? If not where is your data?
4) Do you want the new files saved to the same directory as the original file?

Thanks Fluff, this will be for Monday or Tuesday as I am desperate to get out of the office after a 60 hour workweek .

 

[Fluff]

OK, no rush

 

[EmilyNL]

Hey!

So, to answer your questions:

1) What is the name of sheet containing the data?
Stocked items SE+NL

2) What column holds the supplier name?
Column D

3) Do you have a header in row, with data starting in A2? If not where is your data?
Header in row 1, data starting in A2

4) Do you want the new files saved to the same directory as the original file?
Yes, that will be fine!

Thanks in advance, Fluff!

 

[Fluff]

Ok try this

Sub SplitsheetToWorkbooks()

   Dim SrcWs As Worksheet
   Dim wbk As Workbook
   Dim Cl As Range
   
Application.ScreenUpdating = False

   Set SrcWs = Sheets("Stocked items SE+NL")
   
   If SrcWs.AutoFilterMode Then SrcWs.AutoFilterMode = False
   
   With CreateObject("Scripting.dictionary")
      For Each Cl In SrcWs.Range("D2", SrcWs.Range("D" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then
            .Add Cl.Value, Nothing
            SrcWs.Range("A1").AutoFilter 4, Cl.Value
            Set wbk = Workbooks.Add(1)
            SrcWs.Range("A1").CurrentRegion.SpecialCells(xlVisible).copy wbk.Sheets(1).Range("A1")
            wbk.SaveAs ThisWorkbook.Path & "\" & Cl.Value, [COLOR=#ff0000]51[/COLOR]
            wbk.Close False
         End If
      Next Cl
   End With
   SrcWs.AutoFilterMode = False

End Sub

This will save the files in xlsx format, if you prefer xlsm format, then change the red 51 to 52

 

[EmilyNL]

Ok try this

Sub SplitsheetToWorkbooks()

   Dim SrcWs As Worksheet
   Dim wbk As Workbook
   Dim Cl As Range
   
Application.ScreenUpdating = False

   Set SrcWs = Sheets("Stocked items SE+NL")
   
   If SrcWs.AutoFilterMode Then SrcWs.AutoFilterMode = False
   
   With CreateObject("Scripting.dictionary")
      For Each Cl In SrcWs.Range("D2", SrcWs.Range("D" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then
            .Add Cl.Value, Nothing
            SrcWs.Range("A1").AutoFilter 4, Cl.Value
            Set wbk = Workbooks.Add(1)
            SrcWs.Range("A1").CurrentRegion.SpecialCells(xlVisible).copy wbk.Sheets(1).Range("A1")
            wbk.SaveAs ThisWorkbook.Path & "\" & Cl.Value, [COLOR=#ff0000]51[/COLOR]
            wbk.Close False
         End If
      Next Cl
   End With
   SrcWs.AutoFilterMode = False

End Sub

This will save the files in xlsx format, if you prefer xlsm format, then change the red 51 to 52

Awesome, I can see the files starting to come in now! You're a genius!
I had a question, was I supposed to filter alphabetically or will it automatically group? I'm sure I will know in the next hour anyway, in which case I will do this again .

 

[Fluff]

No need to sort of filter the data, the macro will do that itself.
That said if you sort on Col D first, the macro might be a bit quicker.

 

[EmilyNL]

So just an issue that I encountered. Some of my suppliers have a . in their official name, like Fake Name s.p.a. It will then save as an .A file, LOL. So I have countered this by replacing all dots for space in the data. I didn't filter alphabetically in the end, it works like a charm!

 

[Fluff]

If this is something you'll be doing on a regular basis, I can easily modify the code to do the replace as well.