Help needed with VBA code

[jrudolph]

The following code is used to split a report. What it does is selects the criteria, copies it, and then pastes the data into a new workbook and then saves it using the convention I set. I have the below code copied close to 40 times and the list will probably grow so...

What I am looking to do is come up with better code than the macro I built that will allow me to also add or subtract out "criteria" without needing to find, (to delete out), or copy and edit the existing code to add new criteria. I am also hoping there is a way from within the spreadsheet or even from a pop up box I would be able to change the "month" so that the nameing convention works. I currently open the VBA editor and use find replace to change the month.

Range("A7:Q3000").Select
 
Selection.AutoFilter Field:=1, Criteria1:="AAA"
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:= _
"U:\May 2008\Avg Inc Report - AAA - May08.xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
Range("A1").Select
 
Selection.AutoFilter Field:=1, Criteria1:="AAB"
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:= _
"U:\May 2008\Avg Inc Report - AAB - May08.xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
Range("A1").Select

And So on...


I hope this all make scence. Any help would be greatly appreciated. Thanks in advance.

 

[DonkeyOte]

Yes, use an Input Box on prompt...incorporate something like the below into your script

Sub ....()

Dim I_Date As Date
Dim er As Integer

10
er = 0
I1 = InputBox("Enter Date to Process", "Date", "01-MMM-YY")
On Error GoTo InvalidDate
I_Date = CDate(I1)
If er = 1 Then GoTo 10

....

Exit Sub

InvalidDate:
er = 1
Resume Next

End Sub

you can then use your Input Date and format accordingly in your file paths...

e.g

"U:\" & Format(I_Date, "MMM YYYY") & "\Avg Inc Report - AAA - " & Format(I_Date, "MMMYY") & ".xls"