Oh I know, I was just amazed that I managed to frankenstein together a program that would do what I needed it to. I'm sure I'll be back as I keep working on this project. Thanks again!
AutoFilter Multiple Sheets, Copy, New Book, Paste to Multiple Sheets
- bpdarrow
- Thread is marked as Resolved.
-
-
I'll take another look tomorrow
-
I played around with this some more and attempted to add my formatting macros to the script. Unbelievable - but it runs in about 10 seconds including the time to enter the file name in the save as dialog. I tried adding it with code tags, but it's too long. Here's a sample file with it embedded.
One question - when the save as dialog box opens, it defaults to "All Files (*.*)" as the save-as type and I have to type .xlsx after my file name to get it to save as excel.. How do I get that to default to .xlsx?
-
This sets the filters for GestSaveAsFileName.
Code
Display MoreOption Explicit Sub FilterAndExport() Dim oWb As Workbook, oNewWb As Workbook Dim oWs As Worksheet Dim rRng As Range Dim iX As Integer Dim sCode As String, vNewname On Error GoTo exit_proc Application.ScreenUpdating = False ''/// the activeworkbook must be the original data workbook Set oWb = ActiveWorkbook ''///create new workbook Set oNewWb = Workbooks.Add ''///add 5 sheets Application.SheetsInNewWorkbook = 5 sCode = InputBox("Enter Dealer Code", "Filter Criteria") If sCode = Empty Then MsgBox "No code entered.", vbCritical, "User cancelled" ActiveWorkbook.Close False Exit Sub End If iX = 1 For Each oWs In oWb.Worksheets With oWs If Not .AutoFilterMode Then .Range("A1").AutoFilter .Range("A1").AutoFilter Field:=1, Criteria1:=sCode Set rRng = .AutoFilter.Range rRng.Copy With oNewWb .Sheets(iX).Range("A1").PasteSpecial xlAll .Sheets(iX).Range("A1").CurrentRegion.Cells.WrapText = False .Sheets(iX).Range("A1").CurrentRegion.Columns.AutoFit .Sheets(iX).Name = oWs.Name End With iX = iX + 1 End With Next oWs vNewname = Application.GetSaveAsFilename(FileFilter:= _ "Excel Files (*.xls*)," & "*.xls*") If vNewname <> False Then ActiveWorkbook.SaveAs Filename:=vNewname, FileFormat:=51 exit_proc: Application.ScreenUpdating = True End SubWhat Format do you need to add?
-
Perfect. As far as formatting, it's a lot of clean up stuff - moving come columns around, applying conditional formatting, centering, level-sorting, things like that. It's working AMAZINGLY now. Thank you so much for your help with this.
-
-
Are you sure the conditionl formatting isn't there?
-
Yeah, it's not there. It's not in the source file to begin with. The 9 master files get exported to a shared network drive from QlikSense through nPrinting that turns them into what you see in the example file. Then based on a request I get the data for the necessary dealer code and create a report for that particular request. I've tried applying all the formatting to the master files but they contain so much data that it sometimes locks excel up.
-
Applying formatting with code can be very long. I'll take a look later, where is the formatting code?
-
It's in the file I attached above, but I included it here again. It was too long to paste into code tags, exceeded 10,000 characters. It starts at the end of the sub you wrote.
Participate now!
Don’t have an account yet? Register yourself now and be a part of our community!