vba code to make a list of files from my data using the names in cell c

[tonywatsonhelp]

	A	B	C
1	NAME	EMAIL	COMPANY
2	jo smith	@	SMITHS
3	BOB	@	SMITHS
4	BILL	@	SMITHS
5	PAUL	@	JONES
6	JOHN	@	JONES
7	BOB	@	JONES
8	DAVE	@	JONES
9	LUO	@	DAVIS
10	TIM	@	DAVIS
11	TREV	@	DAVIS
12	JO	@	DAVIS
13	JIM	@	DAVIS
14	MIKE	@	DAVIS

<TBODY>
</TBODY>

HI EVERYONE,

I'm at a total loss so really hope someone can help with this?
I have a spreadsheet and a tab called "s1"

like the above it has a list of companies with employees and emails, now what I need to do is find a way to create individual csv files for each company?

the company names are in column C and are sorted in order so all smiths are together,
I'm looking for a macro so I can take the data, save it into a csv file with the heading Column A "name" Column B "email" Column C "Company"
for each unique name so from above id have one file for SMITH, JONES AND DAVIS with all there employee's in there file.

I can't even get close to this?
I know it can be hard to understand my descriptions sometimes so heres what I need the macro to do if I was writing it in English:

look in column C, copy all the names that match the name in cell C2 along with all the data from the column A and B, and paste it into a csv file with the headings as stated above,
the save this file in the same folder the master spreadsheet was in under the company name.

then once you have done this find the next name in column C and copy this data into its own csv file and continue doing this until all the names have been saved to a file, then stop.

would anyone be able to give me the code I need to do this, I've tried recording it and doctoring it but its not working,

please help

Thanks

Tony

 

[Fluff]

Hello Tony
Is this what you're looking for?

Sub tonywatsonhelp()

    Dim StrtSht As Worksheet
    Dim StrtPth As String
    Dim UsdRws As Long
    Dim Co_list As Variant
    Dim Co_Dict As Scripting.Dictionary
    Dim Cmpys As Variant
    Dim ValU As Variant
    Dim i As Long

Application.ScreenUpdating = False

    Set StrtSht = ActiveSheet
    With ActiveWorkbook
        StrtPth = Left(.FullName, Len(.FullName) - Len(.Name))
    End With
    
    UsdRws = Range("A1").CurrentRegion.Rows.Count
    Co_list = Range("C2:C" & UsdRws)
    
    Set Co_Dict = CreateObject("scripting.dictionary")
    With Co_Dict
        .comparemode = vbTextCompare
        For Each ValU In Co_list
            If Not IsEmpty(ValU) Then
                If Not .exists(ValU) Then .Add ValU, Nothing
            End If
        Next ValU
    End With
    Cmpys = Co_Dict.Keys

    For i = 0 To Co_Dict.Count - 1
        Workbooks.Add
        With StrtSht.Range("A1")
            .AutoFilter
            .AutoFilter Field:=3, Criteria1:=Cmpys(i)
            .CurrentRegion.Copy Destination:=Sheets(1).Range("A1")
        End With
        ActiveWorkbook.SaveAs Filename:=StrtPth & Cmpys(i) & ".csv", FileFormat:=xlCSV
        ActiveWorkbook.Close savechanges:=False
    Next i

    StrtSht.Range("A1").AutoFilter

Application.ScreenUpdating = True

End Sub

 

[tonywatsonhelp]

Hi fluff,
Thanks for your help,
I'm just getting a compile error for some reason?

this is the bit of code its highlighting in yellow:

Dim Co_Dict As Scripting.Dictionary

I've just put this into a normal module hope that's correct?

any ideas?

 

[tonywatsonhelp]

just to let you know it says " user define type undefined" as the error!

 

[Fluff]

Apologies, I should have said that you need to add a reference
got to Tools->References & check Microsoft Scripting Runtime
HTH

 

[tonywatsonhelp]

Fluff,
that is beautiful!
Does exactly what I wanted it to do, and I know I'd never have been able to do that so thank you so much, I really appreciate you taking your time to help me do this.

Truly brilliant!
Thank you so much

Tony

 

[tonywatsonhelp]

Hi just one problem, sorry,

is there anyway after we have done each new document we could delete column C?
iif we could do that this would be perfect?

I don't want to mess up you code by trying

Thanks tony

 

[tonywatsonhelp]

Sorry Fluff,
Don't worry I've done it! (I amaze myself! LOL)

Once again thanks for all your help, this is great

Tony

 

[Fluff]

Thanks for the feedback
I'm just glad to be able to help