Copying data based on a recurring variable

[terrymclery]

Hi there,

I have a spreadsheet that is an export from a database (that doesn't let me change the output criteria).

I am trying to make a workbook that will allow someone to copy the exported data into an Excel template and run a macro. I want the macro to copy all the information for each record into a separate worksheet, based on the manager's name (ie, to create a list of all the jobs a certain manager is in charge of). Ideally, I would like it to automatically name the worksheet after the manager's name.

Column A ("job number", every value is different) / Column B ("job reference title") / Column C ("manager", managers have multiple jobs). Every column thereafter is data that needs to be copied.

I would really appreciate it if anyone can give me a hand solving this problem!

-Terry

 

[tstevens]

As I understand it the souce data is from the data base and you can't put the macro in that file?
I would create a workbook(Book1) that you can just copy all info from the source file into that new file. Then create a Template Workbook(Template) Here is a project I've been working on that sounds like what you want to do this will create a new workbook but if you want it in the same workbook it shouln't be hard to change.

Sub Populate()
Application.ScreenUpdating = False
    Dim MgrName As String
' Start of loop. Creates new workbook for each line.
    Do Until Range("C1") = ""
    MgrName = Range("C1")
    Range("C1").Select
    Selection.Copy
    Workbooks.Add Template:= _
        "pathC:/path/Template"
' In the following lines copy the info from one book to the other
    Windows("Book1").Activate
    Range("A1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Template1").Activate
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
' Deletes line with the info you copied one at a time until all rows have their own book.
    Windows("Book1").Activate
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Windows("Template1").Activate
    Range("A1").Select
' Save workbook as managers name.
    ActiveWorkbook.SaveAs Filename:=Range("C1"), _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWorkbook.Close
    Loop
End Sub

Best regards,
Tyler

 

[Norie]

Terry

You could use advanced filter for this.

Sub DistributeRows()
Dim wsAll As Worksheet
Dim wsCrit As Worksheet
Dim wsNew As Worksheet
Dim LastRow As Long
Dim LastRowCrit As Long
Dim I As Long
    
    Set wsAll = Worksheets("All") ' change All to the sheet name with the data
    LastRow = wsAll.Range("A" & Rows.Count).End(xlUp).Row
    Set wsCrit = Worksheets.Add
    
    ' here C is the column with the criteria you want to filter on
    ' change it if necessary
    wsAll.Range("C1:C" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True
    
    LastRowCrit = wsCrit.Range("A" & Rows.Count).End(xlUp).Row
    For I = 2 To LastRowCrit
    
        Set wsNew = Worksheets.Add
        wsNew.Name = wsCrit.Range("A2")
        ' this will apply the filter and copy the entire row
        wsAll.Rows("1:" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsCrit.Range("A1:A2"), _
         CopyToRange:=wsNew.Range("A1"), Unique:=False
        wsCrit.Rows(2).Delete
        
    Next I
    
    Application.DisplayAlerts = False
    wsCrit.Delete
    Application.DisplayAlerts = True
    
End Sub

 

[terrymclery]

Thanks VERY much for your quick replies Tyler and Norie! It's worked sensationally.

I ended up using the code that Norie sent me and it worked sensationally. I'm very new to using macros in Excel and was in over my head, this has solved so many problems!

Thanks again! (hopefully someday I'll be able to help people out like you guys)

-Terry