Go Premium for a chance to win a PS4. Enter to Win


Excel 2013 - Making separate files automatically based on Rep #

Posted on 2014-11-12
Medium Priority
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 31

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 27

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.
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

LVL 31

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


Author Comment

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

Accepted Solution

gowflow earned 2000 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 31

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 27

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

New feature and membership benefit!

New feature! Upgrade and increase expert visibility of your issues with Priority Questions.

Question has a verified solution.

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

This article describes how you can use Custom Document Properties to store settings and other information in your workbook so that they will be available the next time you open the workbook.
Windows Explorer lets you open cabinet (cab) files like any other folder. In VBA you can easily handle normal files and folders, but opening and indeed creating cabinet files takes a lot more - and that's you'll find here.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

877 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