How to use VBA to create new workbooks for every change in column A

[cmerun]

Good afternoon, all! Newb to VBA here and was hoping someone could help me out with a simple problem I have.

I have a rather large spreadsheet that I'll simplify and break down below:

Merchant	Customer	Address1	Address2
Shop A	Customer M	Address M1	Address M2
Shop A	Customer A	Address A1	Address A2
Shop A	Customer F	Address F1	Address F2
Shop A	Customer D	Address D1	Address D2
Shop B	Customer E	Address E1	Address E2
Shop B	Customer C	Address C1	Address C2
Shop C	Customer G	Address G1	Address G2
Shop C	Customer H	Address H1	Address H2
Shop C	Customer I	Address I1	Address I2
Shop C	Customer K	Address K1	Address K2
Shop D	Customer J	Address J1	Address J2

<tbody>
</tbody>

I'd like to create new workbooks with the info from this master spreadsheet. Every merchant would have their own file and would be named the merchant name plus a specified date, for example: Shop A 9.4.13. So from the information above, I'd like to create 4 new workbooks, one for each shop that contains the data from Shop's row so the Shop A file would have the title row (row 1...same for each workbook) and 4 rows with data below that. The Shop D file would only have the title row and the 1 row of data below that.

Any help would be greatly appreciated!

 

[AlexaS]

Does it have to go into new workbooks? Could it stay in the same workbook and go to new sheets? If it needs to be in new workbooks, how will this workbook be used in the future?

 

[cmerun]

Unfortunately for this particular problem it has to be in new workbooks. I guess I could always run two scripts, one that puts them into their own sheets and then another one that takes each of those sheets and turns them into a workbook?

The original file will be kept as a master file. If it's easier, I can create a copy of the original file before running the script. The newly created files would be saved to the same directory the original file came from if that's possible. If not, they can be saved anywhere and moved to their permanent location later on.

Thoughts?

 

[AlexaS]

Put comments in green to make them easier to see.

Public wbTitle As Range
[COLOR=#008000]'If you have the save in a separate macro you need to make "MyBook" a public variant
[/COLOR]Public MyBook

Sub TEST()
Dim LR As Long
Dim LastCell As Range
MyBook = ActiveWorkbook.Name
LR = Cells(Rows.Count, "A").End(xlUp).Row
i = LR
Range("A" & LR).Activate
Set LastCell = ActiveCell
    Do
        If Cells(i, "A") <> Cells(i - 1, "A") Then
            Cells(i, "A").Activate
            Set wbTitle = ActiveCell
            Range(ActiveCell, Cells(LastCell.Row, 3)).Copy
            Workbooks.Add
            [COLOR=#008000]'Probably going to have to adjust somehow to add header data if necessary
[/COLOR]          Range("A1").PasteSpecial
         [COLOR=#008000] 'Would you want to close the newly created workbook or leave it open to manually close?
[/COLOR]          Save
            Set LastCell = ActiveCell.Offset(-1, 0)
        Else: End If
        i = i - 1
    Loop Until ActiveCell.Value = "Merchant"
    
End Sub

Sub Save()
Dim y, path, file As String
    currentDate = Format(DateAdd("m", 0, Date), "MM.DD.YYYY")
    path = ("[COLOR=#008000]put your path here[/COLOR]")
    file = (wbTitle & " " & currentDate)
    
    If Dir(path, vbDirectory) = "" Then
[COLOR=#008000]      'directory doesn't exist...create it
[/COLOR]      MkDir (path)
        ActiveWorkbook.SaveAs (path & "\" & file & ".xlsx")
    Else
[COLOR=#008000]      'directory exists
[/COLOR]      ActiveWorkbook.SaveAs (path & "\" & file & ".xlsx")
    End If
    
    ActiveWorkbook.Close
[COLOR=#008000]  'If you don't want to save the new workbook automatically (or want to leave it open after saving, take this out and add:
[/COLOR]  Workbooks(MyBook).Activate
    
End Sub

I didn't test the save since I pulled it from another macro of mine that I know works. Obviously you'll have to tweak based on your requirements, but this should at least be a start in the right direction

 

[cmerun]

You're the bomb! Thanks so much!

I was able to make it work by changing Range("A1").PasteSpecial to A2, then following that I made a line for each column header... ex:

Range("A1").Value = "Merchant"
Range("B1").Value = "Customer Name"
etc.

It is giving me a run time error '1004' message at the end of the script but I'm not worried about that because it performs everything successfully.

Thanks, again!

 

[VoG]

An alternative http://www.mrexcel.com/forum/excel-questions/396069-copy-new-worksheets.html

 

[AlexaS]

Thanks VoG - just skimmed the code in the link you posted, looks really cool