Excel 2013 - Making separate files automatically based on Rep #

Posted on 2014-11-12
Last Modified: 2014-11-14
Since I don't know VB, is there a way to take the code below and instead of making the user intervene and input a Rep # each time, can the coding be set up so that it will create a separate file for each rep (based on the Rep #), no matter if there are 50 reps, 100 reps, or 500 reps. And each separate rep file should be named according to Rep # and Rep Name - columns A & B and saved in the same folder.

A file is attached.

Sub Separate()

 Dim myValue As String
    Set myWorkbook = ActiveWorkbook
    myValue = InputBox("Make sure you have saved this workbook first!" & Chr(13) & Chr(13) & "Which rep number do you want?")
    If myValue <> "" Then
        introw = 2
        Do Until Cells(introw, 1) = ""
            Select Case Cells(introw, 1)
            Case myValue
                introw = introw + 1
            Case Else
            End Select
        If Cells(2, 2) = "" Then
            MsgBox "No data!"
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs Filename:="G:\esu1234\excel\" & Cells(2, 1) & " - " & Cells(2, 2) & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            Application.DisplayAlerts = True
        End If
            Workbooks.Open Filename:="G:\esu1234\excel\Kevin Sample Data - macro enabled.xlsm"
        ' Abort
    End If

End Sub
Question by:esu4236
  • 4
  • 3
  • 2
LVL 29

Expert Comment

ID: 40438136
Now it does it putting the sales Rep# " - " Rep Name in the file name will that be ok or only the Rep# ?
LVL 25

Expert Comment

ID: 40438159
here you go.

see the attached file too.

Sub separateFILES()

    '11/12/2014  by ProfessorJimJam  Solution to question number Q8556076
    Dim colLetter As String, SavePath As String
    Dim lastValue As String
    Dim wb As Workbook
    Dim lng As Long
    Dim currentRow As Long
     colLetter = "A"
    SavePath = "G:\efu1234\Excel\" 'Indicate the path to save
    If SavePath = "" Then SavePath = ActiveWorkbook.Path
    'Sort the workbook.
    Application.ScreenUpdating = False
    With ActiveWorkbook.Worksheets(1)
        .Sort.SortFields.Add Key:=.Range(colLetter & ":" & colLetter), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange .Parent.UsedRange.Cells
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
        End With
        For lng = 2 To .Range(colLetter & .Rows.Count).End(xlUp).Row
            If .Cells(lng, colLetter).Value = "" Then Exit For
            lastValue = .Cells(lng, colLetter).Value
            .Cells.AutoFilter field:=.Cells(lng, colLetter).Column, Criteria1:=lastValue
            lng = .Cells(.Rows.Count, colLetter).End(xlUp).Row
            Set wb = Application.Workbooks.Add(xlWorksheet)
            wb.Sheets(1).Name = lastValue
            .Rows(1 & ":" & lng).Copy wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp)
            wb.SaveAs SavePath & Replace(lastValue, ".", " "), 51
        .AutoFilterMode = False
    End With
    Application.ScreenUpdating = True
End Sub

Open in new window


Author Comment

ID: 40438274
ProfessorJimJam:  It seems to work well, except can you make it so that it is naming each individual file by the Rep # and Rep Name?  So the first rep listed, his file would be 1329 - Lyle. Then I think we're good.
LVL 29

Expert Comment

ID: 40438333
Sorry I made a different Sub as do not agree with the proposed type of coding.

Anyway the Macro is called Separate pls run it and chk results.

here is the code
Sub Separate()
Dim WS As Worksheet
Dim WSREP As Worksheet
Dim WBREP As Workbook
Dim MaxRow As Long, I As Long, J As Long, K As Long
Dim sRep As String, sRepFile As String, sFilePath As String, sSheetName As String
Dim SrtRow As Long, EndRow As Long, lCount As Long

'---> Disable Events
With Application
    .EnableEvents = False
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

Set WS = ActiveSheet
MaxRow = WS.Range("A" & WS.Rows.Count).End(xlUp).Row
sFilePath = "G:\efu1234\excel"
'sFilePath = ActiveWorkbook.Path
sSheetName = WS.Name

For J = 2 To MaxRow - 1
    '---> Get Start and End row for Rep
    SrtRow = J
    K = J
        K = K + 1
    Loop Until InStr(1, WS.Cells(K, "A"), WS.Cells(J, "A")) = 0
    EndRow = K - 1
    '---> Test to see if the rep found already have a workbook
    sRepFile = Dir(sFilePath & "\" & WS.Cells(J, "A") & " - " & WS.Cells(J, "B") & ".xlsx")
    If sRepFile = "" Then
        '---> Create the new Workbook
        Set WBREPS = ActiveWorkbook
        sRepFile = sFilePath & "\" & WS.Cells(J, "A") & " - " & WS.Cells(J, "B") & ".xlsx"
        WBREPS.SaveAs Filename:=sRepFile
        Set WSREPS = ActiveSheet
        WSREPS.Name = sSheetName
        lCount = lCount + 1
        '---> Open the Existing workbook and add the current worksheet
        sRepFile = sFilePath & "\" & WS.Cells(J, "A") & " - " & WS.Cells(J, "B") & ".xlsx"
        Set WBREPS = Workbooks.Open(sRepFile)
        WS.Copy after:=WBREPS.Worksheets(WBREPS.Worksheets.Count)
        Set WSREPS = ActiveSheet
        WSREPS.Name = sSheetName
    End If
    '---> Remove Unecessary Rows
    WSREPS.Range("A" & EndRow + 1 & ":A" & WSREPS.Rows.Count).EntireRow.Delete
    If SrtRow > 2 Then
        WSREPS.Range("A2:A" & SrtRow - 1).EntireRow.Delete
    End If
    '---> Autofit
    WSREPS.Cells(1, "A").Select
    '---> Save and close file
    WBREPS.Close savechanges:=True
    '---> release variables
    Set WBREPS = Nothing
    Set WSREPS = Nothing
    '---> Goto next Rep
    J = EndRow
    Application.ScreenUpdating = True
    Application.ScreenUpdating = False
Next J

'---> Disable Events
With Application
    .EnableEvents = True
    .ScreenUpdating = True
    .DisplayAlerts = True
End With

MsgBox "A total of " & lCount & " rep files were created successfully.", vbExclamation, "Create Rep Files"

End Sub

Open in new window

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.


Author Comment

ID: 40438680
gowflow - we're in the testing stage. So far, so good - will keep you posted.
LVL 29

Accepted Solution

gowflow earned 500 total points
ID: 40439295
Noted and pls be advised that this macro will do more than your request and here is its functioning:

1) it will go thru the data and at each sales rep it will first look in the said directory if the file already exist.

    a) If no, then it will create a new file and add the corresponding data to it.
    b) If Yes, the file exist then it will append to it a new sheet labeled month year and the time it had run and append the data to it.

2) Once it is done it will give you a feedback on how many Created and how many Updated.

Reason for this is that some salesman like to receive their results broken down by period for the whole year. Anytime you only need to send the latest figures make sure the macro does not have any sales files in the said location.

This version is the latest as there was a small bug in the previous in case file already exist. Pls use this one.
Try running it once ,,, check the data and then run it again keeping the files in the folder where they were created.


Author Closing Comment

ID: 40442695
gowflow - The macro is working for the end user, and they are very pleased!!! It's saving them a ton of time!!! So thank you so very much for your help on this, and going above and beyond what I even asked for. That's truly great customer service. Your services are very much appreciated. Have a great weekend!!!!
LVL 29

Expert Comment

ID: 40442875
Thank you very much for your very kind words very touched. It is my pleasure to always deliver a true correct working solution.
LVL 25

Expert Comment

ID: 40443116

i am also impressed with your contributions.

you always hit the nail on the head by  providing solutions in the most effective and efficient way.

hats off to you

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

914 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now