Solved: open a text file with complex macro in current workbook

[Gingertrees]

Related to, but sufficiently different from:
http://www.vbaexpress.com/forum/showthread.php?t=29791

Currently, PivotQUEST.xls more or less does the following:
1)open a comma-delimited text file (of user's choice)
2)puts the contents into a spreadsheet
3)cleans it up so it is useable data
4)saves this as a new excel document with title-of-choice in directory of choice
5)turns cleaned data into a pivot table in this new excel file

After xld helped me with a Worksheet_change sub, I realized it would be best to have my data open in a NEW SHEET in PivotQUEST, not saved as a whole new file.
Can that be done with the following code?
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
'////how do I change this to "open in a new sheet in this wkbk?"

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, _
'/////again, want to save in current workbk, not new file!
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 CM"
Range("E3") = " name at"
Range("F3") = "left for an"
Range("G3") = "individual"
Range("H3") = "billing rpt"
Range("I3") = "."
Range("D4") = "Clients srv'd:"
Dim Abba As Long
Abba = Application.WorksheetFunction.CountA(Range("A:A"))
'counts clients served; the minus 7 is so it doesn't count the name header/total cells
'Range("E4") = Cells(1, 1).Formula = "=countA(" & Range("A, A").Address & ")"


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

I've attached both my spreadsheet and a sample text file to demonstrate how this works.

[Gingertrees]

here's the attachment...

[geekgirlau]

I'd suggest you try the following:

Before opening the text file, set the activeworkbook as a workbook variable so that you can refer back to it.
Remove the "Save As".
At some point (either where the Save As is currently or at the end) add an instruction to move the sheet to the workbook object that you defined at the start. I suggest you do this with the macro recorder so you can see the syntax.

[Gingertrees]

*sigh* GeekGirl, I've been trying to do what you suggested for days, and I cannot make it work. When I try to record the macro, I get as far as TRYING to move the WHATEVER.txt spreadsheet to pivotquest.xls, and I get the following error:

"Excel cannot insert the sheets into the destination workbook, because it contains fewer rows and columns than the source. To move or copy the data, you can select the data..." :dunno

I realize this is likely because WHATEVER.txt is still a txt file, displayed in a spreadsheet. That was why I created the SaveAs code in the first place...

So I guess my amended request should go like this:
4) find some way to make Excel copy/move WHATEVER.txt into a new sheet in pivotquest.xls without errors
5) incorporate xld's worksheet change code into this new sheet:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Abba As Long

If Not Intersect(Target, Me.Range("B1")) Is Nothing Then
Application.EnableEvents = False
Abba = Application.WorksheetFunction.CountA(Range("A1:A1000"))
Me.Range("C2").Value2 = Abba - 4
Application.EnableEvents = True
End If
'this would replace the ABBA section of my orig. code
End Sub

Could someone please shed some light on my quandry? Thank you!

[GTO]

Hi Ariel,

I know el zippo/nada about pivots. Was just curious about the warning. How many rows/lines and how many columns are in the text files? And what ver of Excel are you in (at work I presume)

Mark

[Gingertrees]

Hi Mark! Pivottables are my new favorite toys - I managed to work around that part, it's the other stuff I need help with.

D'oh! Curse the version thing...work is 2003, home is 2010b. I thought "compatibility mode" was supposed to take care of problems, but I guess not all...

Anyway, ok, managed to get the sheet to move...but only for that specific file. Here's what the macro showed me:

Workbooks.OpenText Filename:= _
"C:\Documents and Settings\MyDirectory\WHATEVER.txt", 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
Sheets("WHATEVER").Select
Sheets("WHATEVER").Move After:=Workbooks("pivotQUEST.xls").Sheets(2)
'this was supposed to be "move to end"
ActiveWorkbook.Save

Now,
1) how do I get the code to refer to [filename of choice] as opposed to WHATEVER.txt?
2) how can I "paste" the Worksheet Change code (above post) into this new sheet that I've just created?

[GTO]

Hi Ariel :hi:


Now,
1) how do I get the code to refer to [filename of choice] as opposed to WHATEVER.txt?

You really have the answer to this in the code in your first post. It is the Application.GetOpenFilename part.

Rather than opening the textfile in excel and copying the sheet, I think we can get the same data by adding a sheet and a query.

I hope you will not mind, as I took some liberties with your present code.

Most of it should be problem free, but as your example textfile is not the same as the real deal (4 columns instead of 7, the filters cannot find the vals being looked for, etc), and as mentioned, I can barely spell "Pivot Table", let alone code one... I ran into trouble right towards the end.

So please, test and re-write as necessary in a test copy, til you get whatever I missed fixed up.

Though it looks sloppy, I did that on purpose so that you could see what I changed, and hopefully, between that and the comments, as to the whys.


2) how can I "paste" the Worksheet Change code (above post) into this new sheet that I've just created?

I would feel like I was playing with my teacher's instructions there, so didn't touch that part. I would think that rather than adding the change event to the new sheet, I might use the Workbook_SheetChange event and either check a val in an out of the way cell on the new sheet, or a name.

Option Explicit

Sub ImportPivotData()
Dim FileToOpen As String
Dim PRange As Range
Dim FinalRow As Long
Dim FinalCol As Long

Dim wks_txtSource As Worksheet
Dim PivotSheet As Worksheet
Dim strSourcePath As String
Dim strSourceName As String
Dim strSourceExt As String

'// For testing, alter to suit //
ChDrive "G:"
ChDir ThisWorkbook.Path & "\" ' "C:\"

FileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")

If FileToOpen = "False" Then Exit Sub

strSourcePath = Left(FileToOpen, InStrRev(FileToOpen, "\"))
strSourceName = Mid(FileToOpen, Len(strSourcePath) + 1, (InStrRev(FileToOpen, ".") - 1) - Len(strSourcePath))
strSourceExt = Mid(FileToOpen, InStrRev(FileToOpen, "."), 255)

With ThisWorkbook

Set wks_txtSource = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count), _
Type:=xlWorksheet)
With wks_txtSource
With .QueryTables.Add(Connection:="TEXT;" & strSourcePath & strSourceName & strSourceExt, _
Destination:=wks_txtSource.Range("A1"))

.Name = strSourceName
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
'//Note for me - Not in 2000: Origin:=437 USE: xlWindows
.TextFilePlatform = 437 'xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1)
.Refresh BackgroundQuery:=False

.TextFileTrailingMinusNumbers = True

'//Note for me - not in 2000: TrailingMinusNumbers:=True
End With

'// Hopefully I was reading correctly. I added an arg to refer to the sheet//
'// of interest. //
Call RemoveUselessStuff(wks_txtSource) '////that's my little sub from my 1st post

'// As we no longer have a new/added wb, and we already set a reference to //
'// added sheet, we should be able to continue referring to 'wks_txtSource' //
'Set WSD = ActiveSheet

wks_txtSource.Columns.Range("A1", "G1").EntireColumn.AutoFit

' Define input area and set up a Pivot Cache
FinalRow = wks_txtSource.Cells(Application.Rows.Count, 1).End(xlUp).Row
FinalCol = wks_txtSource.Cells(1, Application.Columns.Count).End(xlToLeft).Column
Set PRange = wks_txtSource.Cells(1, 1).Resize(FinalRow, FinalCol)
End With
End With
'Ariel's orig?
' ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
PRange).CreatePivotTable TableDestination:="", _
TableName:="PivotTable3" 'Not in 2000, DefaultVersion:=xlPivotTableVersion10

ThisWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
SourceData:=PRange).CreatePivotTable TableDestination:="", _
TableName:=strSourceName, _
DefaultVersion:=xlPivotTableVersion10
Set PivotSheet = ActiveSheet

With PivotSheet
'ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
.PivotTableWizard TableDestination:=.Cells(3, 1)

With .PivotTables(strSourceName) '("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 not exist in 2000?
'.AddDataField ActiveSheet.PivotTables( _
"PivotTable3").PivotFields("Qty"), "Sum of Qty", xlSum

'// Sorry, I have no idea why this didn't work for me. I believe you said //
'// wrote/recorded in xl2003, which is what I finished this in. Alas, I //
'// could not figure this part out... //
'.AddDataField .PivotTables(strSourceName).PivotFields("Qty"), "Sum of Qty", xlSum
End With

.Range("D2") = "Billing Report"
.Range("D3") = "Select CM"
.Range("E3") = " name at"
.Range("F3") = "left for an"
.Range("G3") = "individual"
.Range("H3") = "billing rpt"
.Range("I3") = "."
.Range("D4") = "Clients srv'd:"

Dim Abba As Long
Abba = Application.WorksheetFunction.CountA(Range("A:A"))
'counts clients served; the minus 7 is so it doesn't count the name header/total cells
'Range("E4") = Cells(1, 1).Formula = "=countA(" & Range("A, A").Address & ")"

.PageSetup.PrintArea = ""
With .PageSetup
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
'Note for me - not in 2000: .PrintErrors = xlPrintErrorsDisplayed
End With
End With
End Sub




Option Explicit

Sub RemoveUselessStuff(wks As Worksheet)
'// I think rather than depending on the active sheet, we can just pass the sheet //
'// as a reference. //
With wks 'ActiveSheet
.Range("A1:G2").EntireRow.Delete
.AutoFilterMode = False

With .Range("A4", Range("A" & Rows.Count).End(xlUp))
.AutoFilter 1, "*Case*"

'// I could be wrong, but I do not see why disregarding an error here would //
'// necessary. //
On Error Resume Next
.Offset(1).SpecialCells(12).EntireRow.Delete
'// added //
On Error GoTo 0
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
On Error GoTo 0
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("CM", "Date", "URN", "SvcName", "Funding", "Qty", "Site")
.Range("a1:g1").Value = myarray
'renames header columns

'// instead of...
' Set r = ActiveSheet.Range("A65536").End(xlUp).Offset(-3 + 1)
' Set s = ActiveSheet.Range("A65536").End(xlUp)
'// ...try:
Set r = .Range(Rows.Count).End(xlUp).Offset(-3 + 1)
Set s = .Range(Rows.Count).End(xlUp)

Range(r, s).EntireRow.Delete
End With
'// added //
On Error GoTo 0

Application.ScreenUpdating = True
End Sub


Hope that helps:)

Mark

[Gingertrees]

Wow Mark, that must have peaked your interest. Either that or you had a real slow day at work ;-) You really cleaned up RemoveUselessness - thanks! And without the reference to the 2003 last row, it doesn't even trigger errors when I run it at home on 2010. :-)

I think you cleaned the other part pretty well, unfortunately I'm still hitting a pivot-table snag and cannot execute the full code to check at this time. I've another thread running specifically for that piece, though, so hopefully someone will be able to help me with that part later on.

Be well, happy new year!

[GTO]

Glad you liked and that its (mostly) working. Hopefully someone will save us on the pivot construction part :-)

[Gingertrees]

OK I amend my earlier statement. Excel does not seem to recognize that wks is supposed to be the activesheet. I tried modifying to
Sub RemoveUselessStuff()
Dim wks As Worksheet
Set wks = ActiveSheet

but that didn't seem to make any difference. now it's basically not running RemoveUselessStuff. Why is that?

[GTO]

OK I amend my earlier statement. Excel does not seem to recognize that wks is supposed to be the activesheet. I tried modifying to
Sub RemoveUselessStuff()
Dim wks As Worksheet
Set wks = ActiveSheet

but that didn't seem to make any difference. now it's basically not running RemoveUselessStuff. Why is that?

Hi Ariel,

The short answer is because you modified the above so that the newly created sheet is no longer being passed by reference to your sub.

See, when you were opening the textfile from excel, you grabbed it as the (activated upon opening) active sheet. We are not doing that. We set a reference to an added sheet upon creation.

See if this makes sense:

Sub ImportPivotData()
Dim FileToOpen As String
Dim PRange As Range
Dim FinalRow As Long
Dim FinalCol As Long

Dim wks_txtSource As Worksheet
Dim PivotSheet As Worksheet
Dim strSourcePath As String
Dim strSourceName As String
Dim strSourceExt As String


'...Statements.....

With ThisWorkbook

'// We set a reference to the added sheet upon creation. This sheet takes //
'// the place of the activesheet you were using when opening the textfile and //
'// creating a seperate file. //
Set wks_txtSource = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count), _
Type:=xlWorksheet)
With wks_txtSource


'...Statements

'// ...So when we pass this sheet by reference to your sub (this is after //
'// the query (textfile data) has been added), this sheet is the one your //
'// sub will work on. //
Call RemoveUselessStuff(wks_txtSource)
'...remainder of statements...
End Sub



'// So here, wks is actually wks_txtSource from the above //
Sub RemoveUselessStuff(wks As Worksheet)


With wks
.Range("A1:G2").EntireRow.Delete
.AutoFilterMode = False

'...other statements...

End Sub


I do not understand what you were trying to do as to modifying this part?

Mark

[Gingertrees]

OK, I now have the main macro working.

[Readers, FYI: the rest of this is purely for discussion/nerdly interest :-) ]
I had to call my old version of RemoveUselessStuff, but it does work. However, RemoveUselessStuff-as-amended, will not run at all.

Two observations:
1) I noticed the suffix "(wks as Worksheet)" causes Sub RemoveUselessStuff to be omitted from the list of macros in the workbook...could this be a problem? That I am trying to "call" what is now a non-macro?
2) perhaps it is my untrained eye, but I see that sub as defining wks as a worksheet, but it never specifies which one (activesheet? "Sheet24"?, ???). It appears the computer doesn't know either, as the code simply will not execute.

Mark: so in answer to your question, I was trying to modify it so it knew which worksheet to execute on.

*sigh* This VBA stuff...sometimes, mosttimes, I feel like a mouse trying to formulate cheese: familiar with the outcome, completely ignorant of any background info...

[GTO]

OK, I now have the main macro working.

Part of my problem in being able to help, is that I can not run it against the textfile provided and get realistic results.

Could you put an example textfile together that is layed out like the real ones, including data that replicates (if the original data is sensitive) data that would normally be getting filtered. Also, data in all seven (by my recollection) columns, as I recall only four columns worth in the example.

If you could zip the example textfile(s) in with the wb in its current "yeah, it's working!" version, it would be so much easier for me to see what's really going on. In short, on top of Markus being rather Blondus, and that there new-fangled Pivot doohickey... well, it just seems unlikely that I can figure out much more without being able to step-thru the code line-by-line and see what you are seeing



[Readers, FYI: the rest of this is purely for discussion/nerdly interest :-) ]

I had to call my old version of RemoveUselessStuff, but it does work. However, RemoveUselessStuff-as-amended, will not run at all.


I'll have to wait to see your next attachment, but I promise including a simple argument in calling the sub is not the problem.



Two observations:
1) I noticed the suffix "(wks as Worksheet)" causes Sub RemoveUselessStuff to be omitted from the list of macros in the workbook...could this be a problem? That I am trying to "call" what is now a non-macro?

No. It is not a non-macro, it is simply a procedure that has a required (vs. Optional) argument included.

In VBA Help, look up Writing a Function Procedure, Writing a Sub Procedure, and probably most everything under See Also.



2) perhaps it is my untrained eye, but I see that sub as defining wks as a worksheet, but it never specifies which one (activesheet? "Sheet24"?, ???). It appears the computer doesn't know either, as the code simply will not execute.

Mark: so in answer to your question, I was trying to modify it so it knew which worksheet to execute on.

*sigh* This VBA stuff...sometimes, mosttimes, I feel like a mouse trying to formulate cheese: familiar with the outcome, completely ignorant of any background info...

In the code I provided and as shown in my last post, 'wks_txtSource' expicitly references an added/created worksheet. wks_txtSource is then passed as the argument in 'Call RemoveUselessStuff(wks_txtSource)'

So see, when RemoveUselessStuff() starts executing, 'wks' will refer to 'wks_txtSource'.

So I am very confdent that someplace in your modifications, your revised code is not passing the correct (or maybe any) sheet.

For an example you can easily see work, lets use the help topic example:

From the vba help topic Writing a Function Procedure (variable declaration added)

Option Explicit

Sub Main()
Dim temp As Double

temp = Application.InputBox(Prompt:= _
"Please enter the temperature in degrees F.", Type:=1)
MsgBox "The temperature is " & Celsius(temp) & " degrees C."
End Sub

Function Celsius(fDegrees)

Celsius = (fDegrees - 32) * 5 / 9
End Function


Create a new/balnk workbook, and paste the above to a Standard Module.

Now place the cursor anyplace in the body of Main().

Press the F8 key. See how it highlights a line? You are now executing line-by-line.

Press the F8 key until the inputbox pops up - enter a value and click OK.

Now before continuing, move your mouse over Celsius(temp) in the msgbox prompt. See how it shows the value?

Okay, now press F8, and after each press, watch what is happening. You will see that the Function is called, and that the we passed temp (a value in this case, an Object reference in your wb) to the function. Note that although the variable is called fDegrees in the function, it is the same value as temp.

Now after stepping thru the function, the now calculated as Celsius value is returned and used as part of the msgbox's prompt.

Okay, back to your Sub. In this case, we are doing the first bit that the example shows, that is, we are passing something to the procedure - in our case, a reference to a specific worksheet. For clarity, we are not trying to return anything, just sending something (whether a value, and object reference or whatnot..)

Hope this helps,

Mark

[GTO]

...I noticed the suffix "(wks as Worksheet)" causes Sub RemoveUselessStuff to be omitted from the list of macros in the workbook...

Oops, forgot that part. I believe you are referencing that it disappears from the macro dialog box. That is simply because any sub with an argument is discluded from the dialog box. Simply put, this is because you could not include the arg required when clicking the run button. Make sense?


*sigh* This VBA stuff...sometimes, mosttimes, I feel like a mouse trying to formulate cheese: familiar with the outcome, completely ignorant of any background info...

That was pretty cute :content:

Don't discourage, in no time you'll be Mighty Mouse! :thumb

Mark

[Gingertrees]

OK here is the latest WORKING edition of this project. I included the excel file, and two text files that are representative of the data reports we get from the state. Each staff member (CM) does work for several clients; this reports how many units (length of time) each worked for their clients on certain days.

There is one completed pivot table already in there for reference.

Thanks for the tip about F8 - and I'll look into the other stuff Monday. I work with xl2003 at work, 2010beta (with incomplete help) at home. If I dust off my old college laptop, I have xl2000 at home...but that's a coin toss. Hence, help file access at home is either obsolete or incomplete.

Anyway, if anyone would like to rip apart my copied and/or newbie coding, feel free, it's how I learn :)
~Ariel