Solved: import from text, run VBA, all in one shot?

[Gingertrees]

My state's database spits out reports that can be saved as comma or tab delimited txt documents. These documents then need to be cleaned up (extra headers deleted, etc). With help from the Forum :hi: , I've cooked up this neat little sub that does what I need...but I'd like some way to automate the following:
1) open a text document in Excel
2) run the Text Import wizard to turn out columns of data
3) run my subroutine
4) offer to save as xls file.
(Running Excel 2003)

Here's my sub:


Sub RemoveUselessStuff()
With ActiveSheet
Range("A1:G2").EntireRow.Delete
.AutoFilterMode = False
With Range("A4", Range("A" & Rows.Count).End(xlUp))
.AutoFilter 1, "*Case*"
On Error Resume Next
.Offset(1).SpecialCells(12).EntireRow.Delete
'deletes extra pointless headers
End With
.AutoFilterMode = False
End With
With ActiveSheet
.AutoFilterMode = False
With Range("b4", Range("b" & Rows.Count).End(xlUp))
.AutoFilter 1, "Page"
On Error Resume Next
.Offset(1).SpecialCells(12).EntireRow.Delete
'deletes extra pointless headers
End With
.AutoFilterMode = False
End With
Application.ScreenUpdating = False
Dim r As Range, s As Range
On Error Resume Next 'Error handler
With ActiveSheet
Dim myarray As Variant
myarray = Array("Employee", "Date", "ID#", "Qty")
Range("a1:d1").Value = myarray
'renames header columns into something meaningful
Set r = ActiveSheet.Range("A65536").End(xlUp).Offset(-3 + 1)
Set s = ActiveSheet.Range("A65536").End(xlUp)
Range(r, s).EntireRow.Delete
'deletes extra junk at the bottom of the report
End With
Application.ScreenUpdating = True
End Sub
Any help would be much appreciated! Thank you!

[mdmackillop]

Try recording a macro to do 1 & 2, call your code from the end of that macro. Use SaveAs with an InputBox to promt you for a save.
If you have problems, let us know.

[Gingertrees]

OK, I did as you suggested, and then went in and cleaned up the code as much as I could. However, I still don't know the exact syntax to do the following:
1) change the "open text file" code from a fixed name/location to an Open menu, so user can choose whatever filename in whatever directory, AND

2) change the "save as" code from a fixed name/location to a Save As menu, so user can choose whatever filename in whatever directory.

Here's my code, cleaned as much as I could:


Sub Macro1()
Workbooks.OpenText Filename:= _
"C:\Filedirectory\billing 12-11.txt", Origin _ '//////fixed location, should be flexible
:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:= _
True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1)), TrailingMinusNumbers _
:=True
Call RemoveUselessStuff
'that's my little sub from my 1st post
Columns(Range("A:A", Range("G:g"))).EntireColumn.AutoFit
'I consolidated this from several lines
ChDir "H:\Filedirectory" '////fixed location, should be flexible
ActiveWorkbook.SaveAs Filename:= _
"H:\Filedirectory\billing 12-11B.xls", FileFormat:=xlNormal, _ '////fixed loc.
'should be flexible
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"'billing 12-11'!R1C1:R444C7").CreatePivotTable TableDestination:="", _
TableName:="PivotTable3", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable3").PivotFields("CM")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable3").PivotFields("SvcName")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable3").PivotFields("Site")
.Orientation = xlPageField
.Position = 2
End With
With ActiveSheet.PivotTables("PivotTable3").PivotFields("Funding")
.Orientation = xlPageField
.Position = 3
End With
With ActiveSheet.PivotTables("PivotTable3").PivotFields("Date")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable3").PivotFields("URN")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables( _
"PivotTable3").PivotFields("Qty"), "Sum of Qty", xlSum
ActiveWindow.SmallScroll Down:=177
Range("D2").Select
ActiveCell.FormulaR1C1 = "Billing Report"
Range("D3").Select
ActiveCell.FormulaR1C1 = _
"select case manager name at left to show an individual billing report for this period."
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
End With
End Sub

[mdmackillop]

Try this (untested)


Option Explicit

Sub Macro1()
Dim FileToOpen
Dim FileSaveName
ChDir "C:\Temp"
FileToOpen = Application _
.GetOpenFilename("Text Files (*.txt), *.txt")
If FileToOpen = False Then Exit Sub
FileSaveName = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If FileSaveName = False Then Exit Sub
Workbooks.OpenText Filename:= _
FileToOpen, origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:= _
True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1)), TrailingMinusNumbers _
:=True
Call RemoveUselessStuff '////that's my little sub from my 1st post
Columns(Range("A:A", Range("G:G"))).EntireColumn.AutoFit
'I consolidated this from several lines
ActiveWorkbook.SaveAs FileSaveName, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"'billing 12-11'!R1C1:R444C7").CreatePivotTable TableDestination:="", _
TableName:="PivotTable3", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
With ActiveSheet.PivotTables("PivotTable3")
With .PivotFields("CM")
.Orientation = xlPageField
.Position = 1
End With
With .PivotFields("SvcName")
.Orientation = xlPageField
.Position = 1
End With
With .PivotFields("Site")
.Orientation = xlPageField
.Position = 2
End With
With .PivotFields("Funding")
.Orientation = xlPageField
.Position = 3
End With
With .PivotFields("Date")
.Orientation = xlColumnField
.Position = 1
End With
With .PivotFields("URN")
.Orientation = xlRowField
.Position = 1
End With
.AddDataField ActiveSheet.PivotTables( _
"PivotTable3").PivotFields("Qty"), "Sum of Qty", xlSum
End With
Range("D2") = "Billing Report"
Range("D3") = "select case manager name at left to show an individual billing report for this period."
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
End With
End Sub

Sub RemoveUselessStuff()
'Your Stuff
End Sub

[Gingertrees]

Close! Here are where is errors:


Option Explicit

Sub Macro6()
Columns.Range("A1", "G1").EntireColumn.AutoFit
'I reworded this, as it errored as I originally had it...
ActiveWorkbook.SaveAs FileSaveName, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.PivotCaches.Add(xlDatabase,) TableDestination:="", _
'/!/!/!/!/!?!?!?!?!?!?!?!?! since the source file can change, what do I type in the above line?

TableName:="PivotTable3", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
'//////...

[Gingertrees]

Nevermind, found the answer. I needed to define my range for "Address" as another variable:
Option Explicit

Sub Macro6()
Dim FileToOpen
Dim FileSaveName
Dim WSD As Worksheet
Dim PRange As Range
Dim FinalRow As Long
Dim FinalCol As Long
ChDir "C:\"

FileToOpen = Application _
.GetOpenFilename("Text Files (*.txt), *.txt")
If FileToOpen = False Then Exit Sub

FileSaveName = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If FileSaveName = False Then Exit Sub

Workbooks.OpenText Filename:= _
FileToOpen, origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:= _
True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1)), TrailingMinusNumbers _
:=True

Call RemoveUselessStuff '////that's my little sub from my 1st post
Set WSD = ActiveSheet

Columns.Range("A1", "G1").EntireColumn.AutoFit
'///////I consolidated this from several lines
ActiveWorkbook.SaveAs FileSaveName, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
' Define input area and set up a Pivot Cache
FinalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
FinalCol = WSD.Cells(1, Application.Columns.Count). _
End(xlToLeft).Column
Set PRange = WSD.Cells(1, 1).Resize(FinalRow, FinalCol)

ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
PRange).CreatePivotTable TableDestination:="", _
TableName:="PivotTable3", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)

With ActiveSheet.PivotTables("PivotTable3")
With .PivotFields("CM")
.Orientation = xlPageField
.Position = 1
End With
With .PivotFields("SvcName")
.Orientation = xlPageField
.Position = 1
End With
With .PivotFields("Site")
.Orientation = xlPageField
.Position = 2
End With
With .PivotFields("Funding")
.Orientation = xlPageField
.Position = 3
End With
With .PivotFields("Date")
.Orientation = xlColumnField
.Position = 1
End With
With .PivotFields("URN")
.Orientation = xlRowField
.Position = 1
End With
.AddDataField ActiveSheet.PivotTables( _
"PivotTable3").PivotFields("Qty"), "Sum of Qty", xlSum
End With

Range("D2") = "Billing Report"
Range("D3") = "select case manager name at left to show an individual billing report for this period."

ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
End With
End Sub