Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Excel 2007 Autofilter to Unique Excel Templates 1

Status
Not open for further replies.

BxWill

MIS
Mar 30, 2009
367
US
thread707-1547015

Have a similar challenge whereby I am interested in using Autofilter to copy data to Excel Templates.

Reviewed the above thread and curious as to what modifications should be made to the code below if I want to filter the data to separate Excel Templates?

In other words, I have built 5 unique Excel Templates at C:\...\Microsoft Data... (with macros to generate pivot tables on the dynamic range in Sheet1) -one for each unique filtered value in my list (Widgets, Bolts,Blocks,Washers,Pipes).

Also, I currently receive a run-time error when running the code below that indicate that Excel cannot access the file 'C:\72BF8000'



Sub Testing()
'
' Testing Macro
'
Dim r As Range, ws As Worksheet, i As Integer
Set ws = ActiveSheet
i = 1
For Each r In

  • ws.[D1].AutoFilter _
    Field:=4, _
    Criteria1:=r.Value

    'r.CurrentRegion.Copy
    ws.[D1].CurrentRegion.Copy
    With Workbooks.Add
    With .Sheets(1)
    .Paste
    .UsedRange.EntireColumn.AutoFit
    .SaveAs "C:\FirstTest" & i & ".xls"
    End With
    .Close
    End With
    i = i + 1
    Next
    End Sub
 

hi,

You cannot save a WORKSHEET.

You must save a WORKBOOK...
Code:
    With Workbooks.Add
      With .Sheets(1)
          .Paste
          .UsedRange.EntireColumn.AutoFit
      End With[b]
      .SaveAs "C:\FirstTest" & i & ".xls"[/b]
      .Close
    End With

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Is it possible to filter to pre-existing MS Excel templates?

In other words, I would like all of the records with "Widgets" in column D (filtered column) to be saved to sheet 1 of a Excel macro-enabled template named "Widgets" at C:\...\Microsoft\Templates. "Bolts" to be saved to sheet 1 of the Excel macro-enabled template named "Bolts", and so on.

Can this be accomplished?

If so, how would the code change?

Currently, I am using a Case statement but appreciate any additional insight.
 
I am interested in filtering the records to Excel templates that I created to store records for each unique group of records.

Within each Excel template, I have macros to generate several pivot tables.

I am not interested in storing the records in a new workbook.

 


1) perform the query, 2) Copy the resultset, 3) locate the last row in the target workbook, and 4) paste into the next row.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Is there a way to perform via code?

Would like to copy to the Excel Template so that I can readily perform pivots.

The plan is to copy to sheet 1 of the respective Excel Template (using the code), then pressing a command button to generate several pivot tables on several worksheets, and then to save the template as a Excel workbook.

Each and every month, I would just use the code and Excel template to generate the pivots...




 
Currently experimenting with an alternative method if the first option is not possible.

Basically, using code below within the Excel template to "pull" data from the MS Excel workbook that contains all of the data instead of "pushing" the filtered data to the MS Excel templates.

Still need to resolve the following issues;

- No column headers are displayed
- I receive all of the data, No data is filtered to the MS Excel Template

Any additional insight is greatly appreciated.



Option Explicit
Sub Copy_XS_Data()
Dim rng As Range
Dim wb As String
Dim MyDrive As String
wb = ThisWorkbook.Name

MyDrive = Worksheets(1).Range("D1")
'Open Workbook'
Workbooks.Open Filename:=MyDrive & "C:\All_Data.xls"
'Filters XS data'
With ActiveWorkbook.Worksheets(1)
'check Autofilter is on, turn on if not
If Not .AutoFilterMode Then .Range("D1").AutoFilter
.Range("P1").CurrentRegion.AutoFilter Field:=2, Criteria1:="=*Widgets*"
If rng Is Nothing Then
Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
Destination:=Workbooks(wb).Worksheets(1).Range("A1")
End If
.ShowAllData
End With
End Sub
 
Is anyone able to offer insight as to why there are no column headers or filtered data when I use the following code within the Excel template file?

Option Explicit
Sub Copy_XS_Data()
Dim rng As Range
Dim wb As String
Dim MyDrive As String
wb = ThisWorkbook.Name

MyDrive = Worksheets(1).Range("D1")
'Open Workbook'
Workbooks.Open Filename:=MyDrive & "C:\All_Data.xls"
'Filters XS data'
With ActiveWorkbook.Worksheets(1)
'check Autofilter is on, turn on if not
If Not .AutoFilterMode Then .Range("D1").AutoFilter
.Range("P1").CurrentRegion.AutoFilter Field:=2, Criteria1:="=*Widgets*"
If rng Is Nothing Then
Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
Destination:=Workbooks(wb).Worksheets(1).Range("A1")
End If
.ShowAllData
End With
End Sub
 

Is there a way to perform via code?
Almost ANYTHING you can do on a sheet, can be coded. Turn on your macro recorder.

why there are no column headers or filtered data
Code:
        .Range("P1").CurrentRegion.AutoFilter Field:=2, Criteria1:=[b]"*Widgets*"[/b]
        If rng Is Nothing Then
            Set rng = .AutoFilter.Range
            [b]rng.Copy _[/b]
            Destination:=Workbooks(wb).Worksheets(1).Range("A1")
        End If
BTW, rng does nothing unless your code loop back again to the SAME RANGE.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 

Only the column headings are displayed.
Well....
What is the value in the filter????? I sure can't see it! Does it make sense?

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Okay,

Returning to my original post.

There has to be a method available via the use of filter or advanced filter to copy filtered results from one Excel 2007 worksheet to multiple Excel macro-enabled templates conditional on the value in column D!

Note, the data currently resides on the worksheet titled "Data" that is sourced from a sql server query. It appears to be quite efficient if the query is initially produced via sql server management studio and the query results saved to a text file at "C:\Query Results."

Currently, I filter on column D (within the Excel worksheet) and manually save to 20 Excel templates every other week, Then, a macro is run to create the pivot summaries on separate worksheets and finally, I save each of the 20 files as a Excel 2007 workbook.

Over the next 5 weeks, the number of reports will grow exponentially - from 20 to over 35! Therefore, manually filtering will not be feasible due to the time involved.

To recap, column D contains the type of products - Widgets, bolts, etc. Therefore, I need to filter all records with "Widgets" to a pre-built MS Excel macro-enabled Template named "Widgets.xltm" every other week. This process is repeated for the remaining 19 product names in column D.

Any further thoughts/insight is greatly appreciated.

Have researched numerous examples of filtering to another worksheet within the same workbook but have not located any examples of filtering to several MS Excel macro-enabled templates or separate MS Excel workbooks.

Also researched the creation of 20 MS Excel workbooks using MS Query to filter against column D in the source workbook but this approach appears to not be as efficient as "pushing the data into 20 separate MS Excel templates (where the pivots are created) and finally saving in a format such as Widgets_Oct15.xlsx (Excel 2007 workbook).



Thanks in advance.

 


Did you understand me? The code works! Does your data and structure fit the code I posted or not?

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Thanks for the insight.

Great code!

Did run it and the workbooks were indeed created.

Ideally, would like to save each file with the unique product name with the current date appended. (For example, Widgets_10.18.10.xlsx)

How would I accomplish?

Now, for the second option, how would I save the filtered results to the first worksheet (sheet titled "data") in the respective macro-enabled Excel templates and then finally save as a Excel 2007 workbook?

I have 20 macro enabled templates - each with the first worksheet titled "Data." For example, the first template is titled "Widgets.xltm" and all templates are located at C:\Documents and Settings\Bsmith8\Application Data\Microsoft\Templates\

 

Code:
    With Workbooks.Add
      With .Sheets(1)
          .Paste
          .UsedRange.EntireColumn.AutoFit
      End With
      .SaveAs "C:\" & YourProductName & "_" & Format(Date,"yy.mm.dd") & ".xlsx"
      .Close
    End With
Option 2 later.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Thanks.

Will run the amended code.

Question - Will the code allow for the "automatic" naming of the 20 unique workbooks with the filtered product name for each workbook?
 


How are your product names stored?

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 

The unique product names are stored in a separate area of the worksheet and are range named "List" as suggested in the archived post.

If I filter column D, I will see all of the unique product names (Widgets, Bolts, etc.)

Overall, the code so far does allow me to quite easily rename all of the files (upon viewing in the Windows Explorer window) if saving each file in accordance to the filtered contents in column D is not possible or require a lot of time to code.

 



So is this the process?
Code:
for each prod in List
   Filter your table using prod as criteria
   copy the visible cells
   add a workbook
   paste in the new workbook sheet 1
   save the new workbook using the prod value and current date
   close the new workbook
next
If so, have at it and post back with your questions. If not, set me straight.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top