Split sheet into workbooks using a workbook template based on data in column A

C

coreysmith

New Member
Joined
Apr 6, 2010
Messages
2
Thank you in advance for any help. I've looked through several threads already and can't seem to find one that fits my exact scenario.

I have a workbook that has a sheet called CustInvData, this sheet contains 4,421 rows of invoice transaction data for 178 customers starting on row 2 (headers on row 1). I need to split the transaction data for each customer out into a workbook template based on the customer name in column A. I need each workbook named by the customer name along with a month and year (example: Bellsouth-0911.xls), this should create 178 unique workbooks. And since we sometimes have to go back and rerun invoices for previous months, I'll need to control the month and year manually in the code.

The parsed data needs to be copied to a pre-formatted invoice template. This template has 2 sheets, Sheet1 is called 'Product Summary', this is a table that uses VLOOKUP functions to read the data in Sheet2 called 'Product Details', this is the sheet the parsed data needs to be copied to for each customer invoice. The 'Product Details' sheet has formatted rows 1 thru 11, row 11 being the header row for the data from CustInvData to be copied. So the parsed data needs to start at row 12.

Last, once the data has been copied into the 'Product Details' sheet, I need the data to be SubTotaled at each change in column J (Product) and use the 'Sum' function to add a Subtotal in column L (Retail Price) for each unique product category.

Example data below, I've simplified it (the actual data array spans from columns A to Y)

Customer Name Product Retail Price
ABC Company AVMPCR 10
ABC Company AVMPCA 15
ABC Company AVMPCR 10
DelawareSouth AMPFLD 20
DelawareSouth EMPFLO 30
DelawareSouth EMPFLO 30
DelawareSouth EMPFLO 30
BellwetherCom APPRAIS 55
BellwetherCom APPRAIS 55
BellwetherCom APPRAIS 55
BellwetherCom APPRAIS 55
BellwetherCom APPRAIS 55

I'm a bit of a novice with macros, but I know Excel pretty well. Please bare with me as I'm learning as I go. Thanks again for your help in advance.

Using Excel 2007 running on Windows Vista
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
Sort by date Sort by votes
Hi and welcome to the forum.

There is something about your post which troubles me. You say you want to split the data by customer name, column A, yet you need to enter a month and a year.

But I have written a solution for the information provided, so here goes.

I have split this into two procedures; Main() and ProcessInvoiceData().

The Main() procedure reads in the month and year and does some basic validation, i.e, for the month:
Code: 
  [COLOR=green]'get the month[/COLOR]
  myMonth = Application.InputBox("Enter Month", _
                                  Default:=Month(Now), _
                                  Type:=1)  'only numeric values allowed
  [COLOR=darkblue]If[/COLOR] myMonth < 0 [COLOR=darkblue]Or[/COLOR] myMonth > 12 [COLOR=darkblue]Then[/COLOR]
    MsgBox "Please enter a valid month!"
    [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
  [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]

It then calls the ProcessInvoiceData() procedure.

Here, there are two paths you will need to edit, one for the template and one for the save directory for the new file.
NB remember the end backslash.
Code: 
  [COLOR=green]'******** EDIT THESE ********************************[/COLOR]
  [COLOR=darkblue]Const[/COLOR] savePath = "C:\Temp\coreysmith[COLOR=red]\[/COLOR]"
  [COLOR=darkblue]Const[/COLOR] templatePath = "C:\Temp\coreysmith\Template.xls"
  [COLOR=green]'*****************************************************[/COLOR]


It then loops through a range in the CustInvData sheet, starting at A2 and ending when the next row in column A does not have a value.

At each change in customer name the template is copied and renamed.
Code: 
      newFilePath = savePath & rng.Value _
                           & "-" & myMonth & myYear & ".xls"
      FileCopy Source:=templatePath, Destination:=newFilePath

The data is then processed to find all the data relevant to the customer.
The data is copied:
Code: 
        [COLOR=green]'copy the data[/COLOR]
        Sheets("CustInvData").Range("A" & rowStart & ":Y" & rowEnd).Copy

The newly created workbook is opened:
Code: 
        [COLOR=darkblue]Set[/COLOR] wb = Workbooks.Open(newFilePath)
And the data is pasted and subtotaled
Code: 
        [COLOR=green]'paste and subtotal[/COLOR]
        [COLOR=darkblue]With[/COLOR] wb.Sheets("Product Details")
          .Range("A12").PasteSpecial
          .Range("A12").Subtotal _
              GroupBy:=10, Function:=xlSum, TotalList:=Array(12), _
              Replace:=True, PageBreaks:=False, SummaryBelowData:=[COLOR=darkblue]True[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]

NB for the sub-totals to work row 11 on the Product Detals sheet in the Template must have headers.

To test the code:
Make a copy of the workbook which has the CustInvData sheet.
Trim the data down to a reasonable size for testing.
Open the workbbok and press Alt+11 to open the VBA editor.
Double click the ThisWorkbook module in the Project Windown on the left hand side.
Copy and paste the code below.
Press F5 to run.

Code: 
[COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit[/COLOR]
 
[COLOR=darkblue]Sub[/COLOR] Main()
  [COLOR=darkblue]Dim[/COLOR] myMonth [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]
  [COLOR=darkblue]Dim[/COLOR] myYear [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]
 
  [COLOR=green]'get the month[/COLOR]
  myMonth = Application.InputBox("Enter Month", _
                                  Default:=Month(Now), _
                                  Type:=1)  'only numeric values allowed
  [COLOR=darkblue]If[/COLOR] myMonth < 0 [COLOR=darkblue]Or[/COLOR] myMonth > 12 [COLOR=darkblue]Then[/COLOR]
    MsgBox "Please enter a valid month!"
    [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
  [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
 
  [COLOR=green]'get the year[/COLOR]
  myYear = Application.InputBox("Enter Year", _
                                 Default:=Year(Now), _
                                 Type:=1)  'only numeric values allowed
  [COLOR=darkblue]If[/COLOR] myYear < 0 [COLOR=darkblue]Or[/COLOR] myYear > Year(Now) [COLOR=darkblue]Then[/COLOR]
    MsgBox "Please enter a valid Year!"
    [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
  [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
 
  myYear = Right(myYear, 2)
 
  [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] errHandler
    Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
    ProcessInvoiceData myMonth, myYear
    MsgBox "Done"
 
errHandler:
  Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
 
[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] ProcessInvoiceData([COLOR=darkblue]ByVal[/COLOR] myMonth [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], _
                               [COLOR=darkblue]ByVal[/COLOR] myYear [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR])
 
  [COLOR=darkblue]Dim[/COLOR] rng [COLOR=darkblue]As[/COLOR] Range            [COLOR=green]'range to loop through[/COLOR]
  [COLOR=darkblue]Dim[/COLOR] newFilePath [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]    [COLOR=green]'save filename[/COLOR]
  [COLOR=darkblue]Dim[/COLOR] rowStart [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
  [COLOR=darkblue]Dim[/COLOR] rowEnd [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
  [COLOR=darkblue]Dim[/COLOR] wb [COLOR=darkblue]As[/COLOR] Workbook
 
  [COLOR=green]'******** EDIT THESE ********************************[/COLOR]
  [COLOR=darkblue]Const[/COLOR] savePath = "C:\Temp\coreysmith\"
  [COLOR=darkblue]Const[/COLOR] templatePath = "C:\Temp\coreysmith\Template.xls"
  [COLOR=green]'*****************************************************[/COLOR]
 
  [COLOR=green]'initialize variables[/COLOR]
  [COLOR=darkblue]Set[/COLOR] rng = Sheets("CustInvData").Range("A2")
  [COLOR=darkblue]If[/COLOR] Len(myMonth) = 1 [COLOR=darkblue]Then[/COLOR] myMonth = "0" & myMonth
 
  [COLOR=green]'loop through the data[/COLOR]
  [COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]Until[/COLOR] rng = ""
    [COLOR=darkblue]If[/COLOR] rng.Value <> rng.Offset(-1, 0).Value [COLOR=darkblue]Then[/COLOR]
      [COLOR=green]'create a new workbook from the template[/COLOR]
      newFilePath = savePath & rng.Value _
                           & "-" & myMonth & myYear & ".xls"
      FileCopy Source:=templatePath, Destination:=newFilePath
      rowStart = rng.Row
      rowEnd = rng.Row
    [COLOR=darkblue]Else[/COLOR]
      rowEnd = rowEnd + 1
      [COLOR=darkblue]If[/COLOR] rng.Value <> rng.Offset(1, 0).Value [COLOR=darkblue]Then[/COLOR]
        [COLOR=green]'copy the data[/COLOR]
        Sheets("CustInvData").Range("A" & rowStart & ":Y" & row[COLOR=darkblue]End[/COLOR]).Copy
        [COLOR=darkblue]Set[/COLOR] wb = Workbooks.Open(newFilePath)
 
        [COLOR=green]'paste and subtotal[/COLOR]
        [COLOR=darkblue]With[/COLOR] wb.Sheets("Product Details")
          .Range("A12").PasteSpecial
          .Range("A12").Subtotal _
              GroupBy:=10, Function:=xlSum, TotalList:=Array(12), _
              Replace:=True, PageBreaks:=False, SummaryBelowData:=[COLOR=darkblue]True[/COLOR]
        End [COLOR=darkblue]With[/COLOR]
        Application.CutCopyMode = [COLOR=darkblue]False[/COLOR]
        wb.Close SaveChanges:=[COLOR=darkblue]True[/COLOR]
        rowStart = rng.Row + 1
        row[COLOR=darkblue]End[/COLOR] = rng.Row + 1
      [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    End [COLOR=darkblue]If[/COLOR]
 
    [COLOR=darkblue]Set[/COLOR] rng = rng.Offset(1, 0)
  [COLOR=darkblue]Loop[/COLOR]
End [COLOR=darkblue]Sub[/COLOR]
 
Upvote 0
WOW! That worked beautifully, your instructions were very easy to follow. This will save us days of copy/paste man hours. Thank you so much! :)
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
VBA to Split Data From an Existing Table into Another Single Worksheet with Header for Each Section
Replies
1
Views
221
John_w
J
B
  • Question
Macro that splits a Master data workbook into multiple workbooks
Replies
0
Views
577
Bobstar
B
C
  • Question
Use Row Data to Create New Sheet from Template and Reference Data
Replies
0
Views
392
ChrisMas92
C
S
  • Question
VBA to copy sheet, rename sheet, copy and paste cells into newly created sheet
Replies
1
Views
1K
Short_bus
S
G
  • Question
VBA - Split file with multiple sheets into new workbooks based on column value
Replies
1
Views
439
DanteAmor
DanteAmor

Forum statistics

Threads
1,215,465
Messages
6,124,980
Members
449,201
Latest member
Lunzwe73

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top