Macro to filter and selectively copy data to a template wb

[westjelly]

Hi,

I'm trying to figure out how to automate a rather time-intensive process and have, as yet, been unable to crack exactly what I need.

What I have:

- MasterData workbook (1 sheet)
- Template (2 sheets - 1st sheet does a bunch of vlookups, calculations on 2nd sheet - data)

I need to selectively copy the data in the masterdata workbook into the template in ever-more specific selections.

The filters I'll be working with are:

1 - Group
2 - Level1
3 - Level2
4 - Level3
5 - Level4

So, right now, I manually:

1. filter for a group.
2. Select the data (B5 to the last row in column DZ)
3. Copy it into the template workbook (the "data" sheet) at Cell B5.
4. "Save as" the template with a naming convention MMDDYY Group File Q3
5. Hit Delete to clear the pasted data
6. Go back to the other sheet and return to step 1, until all groups have been divided.

The next step (you see where this is going) is to further divide. So, I filter by group, THEN by Level1. From there, I copy the data, saving the result as MMDDYY Level1 Group Q3

Once all those are done, I move on Filter by Group, Level1, and Level2

Then by Group, Level1, Level2, and Level3

You can see the redundancy... They all come from the same single worksheet of data.


So, what I'd like to do is run a macro once I have the MasterData sheet finished, which would step through filtering, copying and saving.





One of the gravy aspects:

The template is in 3 versions, depending on how much data will likely be used. Ideally, I would have a macro autoselect which template to use, depending on how many rows of filtered data I'm copying over. Anywhere from 300, to 3000, to 30000 or so. The smaller files calculate quicker.

-or-

Gravy #2

Along the process, any brainstorms on how I could use a single template, but keep it from calculating 30000 rows if there are only 10 or something?

 

[Datsmart]

You have a number of requests all tied into your project here. There is no simple answer. What you are asking is very do-able. Need to break it down into the basic steps.
1. Filter data
2. Copy data to Template
3. Save Template with new name
4. Change Filter Criteria

Do you have any code started for any of these steps yet?
Your post does not include what your Filter criteria is othe than say "Group", "Level1", Level2", etc.

I would suggest doing a search on this forum for "Advanced Filter". AF allows you to export the filtered data to another page or even another workbook. Here is a link that explains some of the features of AF.
http://www.contextures.com/xladvfilter01.html

How to name workbooks using date formating has been discussed here a number of times. Have you searched the forum for examples for that?

Go ahead and post back when you have some specific questions on what is not working on your project. Include as much detail as possible.
Good Luck.

 

[PolarBear]

Here's some quick thoughts:

Turn on your macro recorder, and sort the master sheet by Group, Level 1 and Level 2 (or you can write the code directly if you know it). Then work with logic like this:

Find the last row in the sheet:

LastRow = Sheets(SheetName).Cells(Rows.Count, "A").End(xlUp).Row

Next create a subroutine that finds the first and last rows for a particular
column:

sub FindStartEnd (startRow as Int, colName as string)

intStartG = StartRow (stores the start value)
strCurrGroup = Range(colName & StartRow).Value
strTestGroup = Range(colName & StartRow + 1).Value
while strCurrGroup = strTestGroup
StartRow = StartRow + 1
wend
StartingRow = intStartG
GroupEndRow = StartRow
end sub

The above code simply compares the group names in column A; as long as they are the same, it keeps counting down. When it finds a different group name, it stops, and stores the starting value and end values for that group. Then in your main loop, copy and paste the data:

Range(columnName & StartingRow & ":DZ" & GroupEndRow).Copy

then paste into the destination sheet, and save the sheet using your
name convention

Make sure you declare StartRow, GroupEndRow, and StartingRow as a public variables!

Then your main loop is simply:
StartRow = 5 (that's where your data starts?)
For i = 1 to LastRow - 5
FindStartEnd(StartRow,"A")
copy
paste
save as
increment StartRow (to move to top of next group)
next i

then resort the data from "B5:DZ" & LastRow by Level 1, and follow
the same loop as above, only using "B". Of course, if you really want to get clever, you could put the column headingss into an array, and count through that using a second counter; then your code would be really compact.

Note that by finding the LastRow, your sub will only go through 10 rows if that's all that are there, or 30,000 rows if you have that many. Better declare LastRow and any counters to be Long just in case you have over 32,000 rows!

There are some ideas to get you started...

 

[westjelly]

Thanks for the help in clarifying what it is I have.

Will continue searching and post what code I'm able to work up.

 

[westjelly]

I'm going to try putting an extra sheet (Selection) in the MasterData sheet with an array of the possible combinations for Group, Level I, II, III, and IV. Will make it a dynamic named range, so that any new names could be added. Or combinations that wouldn't be possible could be eliminated.

So I loop through that:

1. set variables (criteria1, 2, 3, 4, 5) according to that sheet
2. filter Sheet1
3. If there are more than 10 records visible, copy the data to the template
4. Save as (have to figure out the naming conventions here...)
5. clear the selection, then go back and move down a row on the selection sheet.
6. Rinse and repeat

Here goes nothin.

 

[westjelly]

Ok, it's messy as all heck...

Wanted to at least post what I'd gotten to work on this. It's not pretty, and I'll need to figure out what lines of code I can consolidate (namely copy/paste stuff), but it's somethin', right?

I put the macro on three machines and ran different cases on each. With a few tweaks, it ran like a charm.


I run it from a "Master" File. This file has a sheet ("Reports") that contains all sorting criteria I want to get data for (presently 380 or so rows) as well as any elements to the folder/naming conventions. The macro goes down that list, sorts the "Data" sheet according to the criteria. If it's more than 10 and less than 699, it copies the data to the template, saves the template, then clears the template selection's contents.

The template that I'm copying into has a bunch of formulas that default to, for example, a range of b1:b688, even if there are only 20 records. One of my gravy items will be tweaking the template so it's somewhat dynamic. The main thing "slowing" the process down is a) calculating the template post-paste then b) calculating post selection.clearcontents.

Will see about continuing to streamline things (and just clean up this code!), but actually being able to post something for a change was nice.

Sub Reporting() 

'    Dim SourceRcount As Long, rnum As Long 
'    Dim basebook As Workbook, mybook As Workbook 
'    Dim sourcerange As Range, destrange As Range 
'    Dim rRange As Range 
    Dim MasterFile As Workbook 
    Dim TemplateF As String 
    Dim Template As Workbook 
    Dim TDate As String 
    Dim TempRange As Range 
    Dim vCount As Integer 
    Dim BasePath As String 
    Dim FoldPath As String 
    Dim FilePart As String 
    Dim rng As Range 
Dim FilteredRow As Integer 



    Application.ScreenUpdating = False 
    Dim rCell As Range 

    On Error Resume Next 

TDate = Format(Now(), "mmddyy") 



Sheets("Data").Activate 

    BasePath = "P:\Testing\" 
    
Set MasterFile = ActiveWorkbook 
    TemplateF = "P:\Templates\Tester.xls" 



    
    Workbooks.Open TemplateF 
    
    
        Set Template = ActiveWorkbook 
        Sheets("Detailed Data").Activate 
        Range("CF6").Value = "- " & TDate 
        MasterFile.Activate 
        
        
            Template.SaveAs Filename:= _ 
       "P:\- Report Processing\Q3 Process\Templates\" & TDate & " Tester.xls" _ 
      , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ 
     ReadOnlyRecommended:=False, CreateBackup:=False 
        
        
        
        
     '   MasterFile.Activate 
        
        lrow = LastRow(Sheets("Reports")) 
        
        
  For MastRow = 2 To lrow 
        
        'Select depending on count 
        MasterFile.Activate 
        Sheets("Reports").Activate 
        
        Vgroup = Range("a" & MastRow).Value 
        Lvl1 = Range("b" & MastRow).Value 
        Lvl2 = Range("c" & MastRow).Value 
        Lvl3 = Range("d" & MastRow).Value 
        Lvl4 = Range("e" & MastRow).Value 
        vCount = Range("f" & MastRow).Value 
        RepFile = TDate & " " & Range("G" & MastRow).Value 
        FoldPath = Range("h" & MastRow).Value 
        FilePart = Range("i" & MastRow).Value 
        Sheets("Data").Activate 
        

        
    Select Case vCount 
    

       
    Case 4 
    
          With Sheets("Data") 
     .AutoFilterMode = False 
     .Range("a1:DZ1").AutoFilter 
     .Range("a1:DZ1").AutoFilter Field:=14, Criteria1:=Vgroup 
     .Range("a1:DZ1").AutoFilter Field:=10, Criteria1:=Lvl1 
     .Range("a1:DZ1").AutoFilter Field:=11, Criteria1:=Lvl2 
     .Range("a1:DZ1").AutoFilter Field:=12, Criteria1:=Lvl3 
     End With 
    
    
        Set rng = ActiveSheet.AutoFilter.Range 
    FilteredRow = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 

        Select Case FilteredRow 
            Case Is < 10 
            Case Else 
  
         Template.Sheets("Detailed Data").Range("CF5").Value = "Level 3" 
   
    Range("b2:am7100").Select 
    Selection.SpecialCells(xlCellTypeVisible).Select 
    
    Selection.Copy 
    
  
    
    Template.Activate 
    Sheets("Detailed Data").Activate 
    
    Range("B5").Select 
    ActiveSheet.Paste 
        
    
    
    
    Template.SaveAs Filename:=BasePath & FoldPath & "\Reports\" & TDate & "\Level 3\" & RepFile _ 
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ 
        ReadOnlyRecommended:=False, CreateBackup:=False 
    Selection.ClearContents 
       Range("B5").Select 
       

       End Select 'Nested 
       
    Case 1 
    
          With Sheets("Data") 
     .AutoFilterMode = False 
     .Range("a1:DZ1").AutoFilter 
     .Range("a1:DZ1").AutoFilter Field:=14, Criteria1:=Vgroup 
     End With 
    
    Set rng = ActiveSheet.AutoFilter.Range 
    FilteredRow = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 

        Select Case FilteredRow 
            Case Is > 698 
            MsgBox (Vgroup & " Group File") 
            Case Is < 10 
            Case Else 
    
    Template.Sheets("Detailed Data").Range("CF5").Value = "Group" 

    Range("b2:am7100").Select 
Selection.SpecialCells(xlCellTypeVisible).Select 
'   FilteredRows = Selection.Columns(2).SpecialCells(xlCellTypeVisible).Count - 1 
'        MsgBox (FilteredRows) 

    Selection.Copy 
    
    Template.Activate 
    Sheets("Detailed Data").Activate 
    Range("B5").Select 
    ActiveSheet.Paste 
        
    
    
    
    Template.SaveAs Filename:=BasePath & FoldPath & "\Reports\" & TDate & "\" & RepFile _ 
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ 
        ReadOnlyRecommended:=False, CreateBackup:=False 
    Selection.ClearContents 
       Range("B5").Select 

                    End Select  'Nested Select 
                    
    Case 2 
             With Sheets("Data") 
     .AutoFilterMode = False 
     .Range("a1:DZ1").AutoFilter 
     .Range("a1:DZ1").AutoFilter Field:=14, Criteria1:=Vgroup 
     .Range("a1:DZ1").AutoFilter Field:=10, Criteria1:=Lvl1 
     End With 
       
           Set rng = ActiveSheet.AutoFilter.Range 
    FilteredRow = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 

        Select Case FilteredRow 
            Case Is > 698 
            MsgBox (Vgroup & " " & Lvl1 & " Lvl1 File") 
            Case Is < 10 
            Case Else 
  
       Template.Sheets("Detailed Data").Range("CF5").Value = "Lvl1" 

        
    Range("b2:am7100").Select 
Selection.SpecialCells(xlCellTypeVisible).Select 
'   FilteredRows = Selection.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 
'        MsgBox (FilteredRows) 
    Selection.Copy 
    
    Template.Activate 
    Sheets("Detailed Data").Activate 
    Range("B5").Select 
    ActiveSheet.Paste 
        
    
    
    
    Template.SaveAs Filename:=BasePath & FoldPath & "\Reports\" & TDate & "\Level 1\" & RepFile _ 
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ 
        ReadOnlyRecommended:=False, CreateBackup:=False 
    Selection.ClearContents 
       Range("B5").Select 
       



                    End Select  'Nested Select 
                                
    Case 3 
          With Sheets("Data") 
     .AutoFilterMode = False 
     .Range("a1:DZ1").AutoFilter 
     .Range("a1:DZ1").AutoFilter Field:=14, Criteria1:=Vgroup 
     .Range("a1:DZ1").AutoFilter Field:=10, Criteria1:=Lvl1 
     .Range("a1:DZ1").AutoFilter Field:=11, Criteria1:=Lvl2 
     End With 
        
            Set rng = ActiveSheet.AutoFilter.Range 
    FilteredRow = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 

        Select Case FilteredRow 
            Case Is < 10 
            Case Else 
        
        Template.Sheets("Detailed Data").Range("CF5").Value = "Lvl2" 
  
    Range("b2:am7100").Select 
    Selection.SpecialCells(xlCellTypeVisible).Select 
  
        
    Selection.Copy 
  
    Template.Activate 
    Sheets("Detailed Data").Activate 
    Range("B5").Select 
    ActiveSheet.Paste 
        
    
    
    
    Template.SaveAs Filename:=BasePath & FoldPath & "\Reports\" & TDate & "\Level 2\" & RepFile _ 
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ 
        ReadOnlyRecommended:=False, CreateBackup:=False 
    
    Selection.ClearContents 
    Range("B5").Select 

       End Select 'Nested 
       
           Case 5 
    
          With Sheets("Data") 
     .AutoFilterMode = False 
     .Range("a1:DZ1").AutoFilter 
     .Range("a1:DZ1").AutoFilter Field:=14, Criteria1:=Vgroup 
     .Range("a1:DZ1").AutoFilter Field:=10, Criteria1:=Lvl1 
     .Range("a1:DZ1").AutoFilter Field:=11, Criteria1:=Lvl2 
     .Range("a1:DZ1").AutoFilter Field:=12, Criteria1:=Lvl3 
     .Range("a1:DZ1").AutoFilter Field:=13, Criteria1:=Lvl4 
     End With 
     
         Set rng = ActiveSheet.AutoFilter.Range 
    FilteredRow = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 

        Select Case FilteredRow 
            Case Is < 10 
            Case Else 
  
         Template.Sheets("Detailed Data").Range("CF5").Value = "Level 4" 
   
    Range("b2:am7100").Select 
    Selection.SpecialCells(xlCellTypeVisible).Select 
       

    Selection.Copy 
   
    
    Template.Activate 
    Sheets("Detailed Data").Activate 
    
    Range("B5").Select 
    ActiveSheet.Paste 

    
    Template.SaveAs Filename:=BasePath & FoldPath & "\Reports\" & TDate & "\Level 4\" & RepFile _ 
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ 
        ReadOnlyRecommended:=False, CreateBackup:=False 
    Selection.ClearContents 
       Range("B5").Select 



       End Select 'Nested 

       
    Case Else 
    End Select 

    Next MastRow 
    
    Template.Close 
    Sheets("Data").AutoFilterMode = False 
    Application.ScreenUpdating = True 
        
        End Sub