Solved

Excel 2013 - Making separate files automatically based on Rep #

Posted on 2014-11-12
9
95 Views
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
                Rows(introw).Delete
            End Select
        Loop
        If Cells(2, 2) = "" Then
            MsgBox "No data!"
        Else
            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"
        myWorkbook.Close
    Else
        ' Abort
    End If

End Sub
Kevin-Sample-Data---macro-enabled.xlsm
0
Comment
Question by:esu4236
  • 4
  • 3
  • 2
9 Comments
 
LVL 29

Expert Comment

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

Expert Comment

by:ProfessorJimJam
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
            .Apply
        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
            wb.Save
            wb.Close
        Next
        .AutoFilterMode = False
    End With
    Application.ScreenUpdating = True
End Sub

Open in new window

Kevin-Sample-Data---macro-enabled.xlsm
0
 

Author Comment

by:esu4236
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.
0
Does Powershell have you tied up in knots?

Managing Active Directory does not always have to be complicated.  If you are spending more time trying instead of doing, then it's time to look at something else. For nearly 20 years, AD admins around the world have used one tool for day-to-day AD management: Hyena. Discover why

 
LVL 29

Expert Comment

by:gowflow
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
    Do
        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
        WS.Copy
        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
    Else
        '---> 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.UsedRange.EntireColumn.AutoFit
    
    WSREPS.Activate
    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
    WS.Activate
    DoEvents
    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




gowflow
Kevin-Sample-Data---macro-enabled.xlsm
0
 

Author Comment

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

Accepted Solution

by:
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.

gowflow
Kevin-Sample-Data-V01.xlsm
0
 

Author Closing Comment

by:esu4236
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!!!!
0
 
LVL 29

Expert Comment

by:gowflow
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.
Regards
gowflow
0
 
LVL 25

Expert Comment

by:ProfessorJimJam
ID: 40443116
gowflow,

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
0

Featured Post

Master Your Team's Linux and Cloud Stack!

The average business loses $13.5M per year to ineffective training (per 1,000 employees). Keep ahead of the competition and combine in-person quality with online cost and flexibility by training with Linux Academy.

Question has a verified solution.

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

How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

770 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