Need an Excel workbook with code to open an excel file, slice it into 4 separate files.

Have an excel file containing sales data for 4 sales people. Need a master workbook that will have code and a button to open this sales data file, slice it into the 4 sales people as 4 separate files, and preserve the sub total and grand total features, which are now static data. We need to sub total by customer, and a grand total at the end of each file.
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Martin LissOlder than dirtCommented:
I'll start on it now.
Martin LissOlder than dirtCommented:
For the individual salesperson's file, do you need both a total and a grand total? I assume no, because I assume they would be the same.
bobrossi56Author Commented:
Each customer break must sub total, then a grand total at the end, just the revenue items.
OWASP Proactive Controls

Learn the most important control and control categories that every architect and developer should include in their projects.

Martin LissOlder than dirtCommented:
Try this. I'm attaching two workbooks, the master workbook called Master.xlsm which has a button that starts the process (including opening JREPORT-EXTRACT) and a template workbook called Salesperson.xltm which will be used by the master to generate the individual salesperson files. If you can, please store the template in the folder with JREPORT.

In the master workbook's modGenenerate module you'll find a constant called PATH_TO_WORKBOOKS. It is the path where the code will look for the JREPORT and template files. Change it to that folder's path including the "\" at the end. If you don't store them both in the same place the code will need to be changed slightly, but for testing I assume you could create a folder that contains them both.

NOTE: EE won't allow me to attach an xltm file so I've renamed it Salesperson.xlsm. Please rename it to xltm after you download it.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
bobrossi56Author Commented:
WOW, that was fast Martin!!! I am off now till Tuesday next week, although I may remote in Monday, so I will try this Mon or Tues and let you know how it worked out.
Thanks again and have a great weekend...
Martin LissOlder than dirtCommented:
I had previously done something similar so I just had to modify what I already had. Please substitute this macro for the one that's in the Master workbook. It contains complete documentations and niceties like messages in Excel's status bar to tell you what's going on.

Private Sub GenerateFiles()

    Dim wbJRPT As Workbook
    Dim wbMaster As Workbook
    Dim wsDataSource As Worksheet
    Dim wbSalesperson As Workbook
    Dim strWorkbookName As String
    Dim intSP As Integer
    Dim lngLast As Long
    Dim lngFirst As Long
    Dim lngRow As Long
    Dim colNames As New Collection
    ' This is the path to the JREPORT-EXTRACT and Salesperson.xltm files
    Const PATH_TO_WORKBOOKS = "C:\Safari downloads\"
    ' Check to see if the path exists
    If Dir(PATH_TO_WORKBOOKS, vbDirectory) = "" Then
        MsgBox "Please change the value of the 'PATH_TO_WORKBOOKS' constant " _
             & "in the GenerateFiles macro " & vbCrLf _
             & "so that it reflects the folder where JREPORT-EXTRACT.xlsx and Salesperson.xltm " _
             & "are stored.", vbOKOnly + vbExclamation
             Exit Sub
    End If
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set wbMaster = ActiveWorkbook
    ' Open the JREPORT workbook
    Set wbJRPT = ActiveWorkbook
    ' Define a worksheet object that is the source of the data
    Set wsDataSource = wbJRPT.Sheets("Sheet1")
    ' Acativate the source sheet
    ' Create a collection of unique salesperson names
    With wsDataSource
        For lngRow = 3 To .UsedRange.Rows.Count - 2
            On Error Resume Next ' bypass the error when a duplicate is found
            If Cells(lngRow, 1).Text <> "" And Cells(lngRow, 1).Text <> "Total" Then
                ' Add the salesperson name to the collection. The first Cells(lngRow, 1).Text
                ' value is the key and the second is the value. Duplicate keys are not allowed
                ' so when the duplicates are processed an error occurs which is ignored
                ' and the duplicate is not added
                colNames.Add Cells(lngRow, 1).Text, Cells(lngRow, 1).Text
            End If
            ' Tirn off error handling
            On Error GoTo 0
    End With
    For intSP = 1 To colNames.Count
        ' Create the name for the saleslperson workbook
        strWorkbookName = colNames(intSP) & "-file" & ".xlsm"
        ' Show what's going on by displaying a message in Excel's status bar
        Application.StatusBar = "Creating " & strWorkbookName
        ' The salespersons names are in merged cells in col A and we need to know the
        ' first row of the first merged cell for the salesperson...
        lngFirst = wsDataSource.Columns("A").Find(colNames(intSP), SearchDirection:=xlNext, LookIn:=xlValues, LookAt:=xlWhole).Row
        ' ...and the last row of last merged merged cell for the salesperson.
        lngLast = wsDataSource.Columns("A").Find(colNames(intSP), SearchDirection:=xlPrevious, LookIn:=xlValues, LookAt:=xlWhole).Row
        ' It's a merged cell so find the last row of the merged area
        lngLast = wsDataSource.Cells(lngLast, 1).MergeArea(wsDataSource.Cells(lngLast, 1).MergeArea.Count).Row
        ' Create the salesperson workbook from the template
        Workbooks.Add PATH_TO_WORKBOOKS & "Salesperson.xltm"
        Set wbSalesperson = ActiveWorkbook
        ' Copy the source data for the salesperson
        wsDataSource.Range("A" & lngFirst & ":A" & lngLast).EntireRow.Copy
        ' Don't ask if the data in the destination workbook should be overwritten
        Application.DisplayAlerts = False
        ' Paste the copied data to the salesperson workbook, just under the headings
        wbSalesperson.Worksheets("Sheet1").Range("A3").PasteSpecial (xlPasteAll)
        ' Save it using the salesperson's name. DisplayAlerts = False above also
        ' causes any older version of the destination workbook to be replaced.
        wbSalesperson.SaveAs strWorkbookName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        Application.DisplayAlerts = True
        ' Unselect the data
        Application.CutCopyMode = False
        ActiveWindow.ScrollRow = 1

    ' Close JREPORT because it's not needed any longer.
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    Application.StatusBar = ""
End Sub

Open in new window

bobrossi56Author Commented:
OK, finally getting to test this Martin...
bobrossi56Author Commented:
Beautiful Martin. Only thing I would like to be able to change is where the 4 sales person files get saved to. I would like them to be saved to the same path as defined in the PATH_TO_WORKBOOKS = statement. How do I do that? are a genius....
Martin LissOlder than dirtCommented:
You should be able to do it by just changing the current SaveAs line to

wbSalesperson.SaveAs PATH_TO_WORKBOOKS & strWorkbookName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
bobrossi56Author Commented:
Yep...that did it. Thanks Martin. May I add your email to my genius.doc file should I need future assistance with this?
bobrossi56Author Commented:
Another PERFECT solution!!! I am so appreciative.
Martin LissOlder than dirtCommented:
You're welcome and sure, add me to your list.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.