PDA

View Full Version : VBA code for text to column in 2002



Abi
05-08-2006, 07:02 AM
Norie and Gday Bruce at the Ozgrid Forum have been very helpful in creating a macro for me that imports country details from a txt file.

There are still a couple of twitches though, I hope I can get some help with. This type of macro is very advanced for me, so I'm starting completely from scratch...

But here goes:

1) I'd like the amounts to be placed in the columns below the headers, rather than in a single string, and don't know how to do that
2) I'd like to include a column called Division and have the division names listed in that column, and don't know how to do that
2) When I import the report in its entirety, I get a "Run-time error '62': Input past end of file" error, and don't know how to correct that
3) I'd like each sheet (except 'All') to sum each column at the end of import, and don't know how to do that

I posted this thread 6 days ago at the Ozgrid Forum but haven't had a response from anyone. I also posted it to Google's Forum yesterday but still no response.

If anyone can help me out I'd be most grateful!

The spreadsheet (ABI Country2) and the text file (fia) can be found under the original link. If you can't get to the data, I can also attach them on this site
http://www.ozgrid.com/forum/showthre...t=47562&page=3 (http://www.ozgrid.com/forum/showthre...t=47562&page=3)

Jacob Hilderbrand
05-08-2006, 07:17 AM
Moved to Excel Forum.

Abi
05-27-2006, 09:31 AM
Bump up for help. Here's the VBA code that was written for me:


Option Explicit
Sub test()
Dim wsAll As Worksheet, wsCrit As Worksheet, wsNew As Worksheet
Dim LastRowCrit As Long, LastRow As Long, I As Long
Dim strPath As String, x As String, strCountry As String
Dim arrHeadings
Dim FF
arrHeadings = Array("COUNTRY", "DIVISION", "SW MEDIA&PUBS EXT ORDERS", _
"SW MEDIA&PUBS INT ORDERS", _
"NON-SW MEDIA&PUBS EXT ORDERS", _
"NON-SW MEDIA&PUBS INT ORDERS", _
"PCCO/SG&A", "TOTAL COST DKK", "TOTAL COST USD")

Range("A1").Resize(, UBound(arrHeadings) + 1) = arrHeadings

FF = FreeFile(1)
I = 2

'Write path where file is stored
strPath = "C:\Documents and Settings\DK94650\My Documents\My Stuff\Excel\fia.txt"

Open strPath For Input As #FF
While Not EOF(FF)

While Left(x, 8) <> " COUNTRY" And Not EOF(FF)
Line Input #FF, x
Wend
strCountry = Mid(x, 11, 3)
While Left(x, "1") <> "-"
Line Input #FF, x
Wend

If Not EOF(FF) Then
Do
Line Input #FF, x
If Left(x, "1") <> "-" Then

Range("A" & I) = strCountry
Range("B" & I) = x
I = I + 1
End If
Loop Until Left(x, "1") = "-"
Line Input #FF, x
End If
Wend
Close #FF
LastRow = Range("B" & Rows.Count).End(xlUp).Row

Range("B2:B" & LastRow).TextToColumns Destination:=Range("B2"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(17, 1), Array(33, 1), Array(56, 1), Array(67, 1), _
Array(83, 1), Array(100, 1), Array(117, 1)), DecimalSeparator:=",", _
ThousandsSeparator:="."

Set wsAll = Worksheets("All")
LastRow = wsAll.Range("A" & Rows.Count).End(xlUp).Row
Set wsCrit = Worksheets.Add

wsAll.Range("A1:A" & LastRow).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=wsCrit.Range("A1"), Unique:=True

LastRowCrit = wsCrit.Range("A" & Rows.Count).End(xlUp).Row
For I = 2 To LastRowCrit - 1

Set wsNew = Worksheets.Add
wsNew.Name = wsCrit.Range("A2")
wsAll.Rows("1:" & LastRow).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=wsCrit.Range("A1:A2"), _
CopyToRange:=wsNew.Range("A1"), Unique:=False
wsCrit.Rows(2).Delete
Next I
Application.DisplayAlerts = False
wsCrit.Delete
Application.DisplayAlerts = True

End Sub

mdmackillop
05-28-2006, 11:29 AM
Hi Abi,
I can't access your data. Can you post it here?. Use Manage Attachments in the Go Advanced section.
Regards
MD

Abi
05-29-2006, 12:43 AM
Hi Abi,
I can't access your data. Can you post it here?
Regards
MD
Hello, here it is. I tried to upload the txt file too, but wasn't able to.

mdmackillop
05-29-2006, 10:54 AM
Hi Abi,
Try zipping your text file first.
Regards
MD

Abi
05-30-2006, 03:35 AM
Hi MD, here it is. As you can see in the xls-file all the amounts are listed in column B. What I'm interested in is that e.g. 382,35 is displayed in the 'SW MEDIA&PUBS EXT' column and so forth...

Apps
05-30-2006, 07:04 AM
Hi Abi,

It seemed to me that the code that you have recieved from the peeps on Ozgrid was fine, but was hindered by the format of the data it was using (your text file), as there are spaces and not tabs in the data which prevents proper delimiting (plus the fact that the Division info has a purposeful space in it).

Try the code below to see if this gives you what you are looking for, the idea being that running the macro 'TextFileConverter' extracts the data using your original 'Ozgrid' code, and then runs a secondary 'cleaning' process to extract the correct portions of the individual lines.


Sub xSplitTest()
Dim Twb As Workbook
Dim Tws As Worksheet
Dim xTgtRng As Range, r As Range
Dim xRow As Long
Dim xCol As Integer, i As Integer
Dim xTgt$, Tgt2$
Dim xSplitArray() As String
'set definitions----------------------------
Set Twb = ThisWorkbook
Set Tws = Twb.Sheets(1) '<redefine target sheet if needed
Set xTgtRng = Tws.Range("B2:B65536") '<redefine correct range if needed
'-------------------------------------------
'Main Loop==================================
For Each r In xTgtRng
If IsEmpty(r) Then GoTo xSkip
xTgt$ = Mid(r, 14, 1000) '<extract data from line (excluding Div info)
'Debug.Print xTgt$
xRow = r.Row
xCol = 3 '<starting column for paste(excluding Div)
Tws.Cells(xRow, 2).Value = Trim(Left(r, 13)) '<paste Division info as text(including Space)
xSplitArray = Split(xTgt$, " ") '<VBA Split function writes to Array
For i = 0 To UBound(xSplitArray) '<Loop thru Array
If Trim(xSplitArray(i)) <> "" Then '<if Array entry is relevant then paste...
Tws.Cells(xRow, xCol).Value = xSplitArray(i) 'into relevant row/col position
xCol = xCol + 1 '<column counter for reference
End If
Next i
xSkip:
Next r
'============================================
End Sub


Sub TextFileConverter()
Call test
Call xSplitTest
End Sub


Hope this proves useful for you. :thumb

lawrenb
05-30-2006, 07:10 AM
I have written two routines and each works okay separately, as long as nothing it selected on either sheet. However, when I trycalling one routine from the other, I get "Run time error 1004 Application-defined Object-defined Error"

See Range1Update & ExtractSumCode

I think it has to do with switching between sheets. Each time I get the error, if I go to the file/sheet and click off the last selected area, the routine works fine.

Can someone help with this ??
********************************************************

Sub Range1Update()
'This routine updates the range "Range1" to provide an effective table for customer SumCode

ActiveWorkbook.Names("Range1").Delete
With Worksheets("Reference").Range("D1")
Range(.Offset(0, 0), .Offset(0, 2).End(xlDown)).Name = "Range1"
End With
With Worksheets("Reference").Range("Range1").Select
ActiveSheet.Select
Selection.Sort Key1:=Range("D1"), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False _
, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers, _
DataOption2:=xlSortNormal
End With


Sub ExtractSumCode()

Dim i As Integer
Dim RCount As Long
Dim SumCode As Range, TestTable As Range
Dim cell As Range

Call Worksheets("Reference").Range1Update
With Worksheets("AR_Aging").Range("A2")
RCount = Range(.Offset(0, 0), .End(xlDown)).Count
End With
ActiveSheet.Select
With Worksheets("AR_Aging").Range("M2")

.Formula = "=VlookUp(A2,Range1,3)"
End With
With Worksheets("AR_Aging").Range("M2")
.Copy
Range(.Offset(0, 0), .Offset(RCount - 1, 0)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End With
With Worksheets("AR_Aging").Range("M1")
.Value = "SumCode"
.Font.Bold = True
Range("P1").Range(.Offset(1, 0), .End(xlDown)).Name = "SumCode"
End With

End Sub

Norie
05-30-2006, 07:59 AM
lawrenb

Is your question connected to this thread?

If it isn't start a new one.:)

Abi
05-30-2006, 08:43 AM
Hi Abi,

It seemed to me that the code that you have recieved from the peeps on Ozgrid was fine...

Beautiful, Apps! It works. Now I just have a couple of twitches more:

1) My text report includes details for AREA I'd like to include in the spreadsheet. I tried to adjust this line:

While Left(x, 8) <> " COUNTRY" And Not EOF(FF) with
While Left(x, 8) <> " COUNTRY" or <> " AREA" And Not EOF(FF)

but couldn't get it to work

2) When I import the report in its entirety, I get a "Run-time error '62': Input past end of file" error. How do I get past this?

3) I'd like each sheet (except 'All') to sum each column at the end of import, and don't know how to do that

Thanks for everything so far...

Apps
06-01-2006, 08:50 AM
Hello again Abi,

Glad the code worked ok for you.

In answer to part 1) above, you changed the line to :


While Left(x, 8) <> " COUNTRY" or <> " AREA" And Not EOF(FF)


which was almost right, but you have to include the Left statment in the AREA part as well, try:


While Left(x, 8) <> " COUNTRY" or Left(x, 5) <> " AREA" And Not EOF(FF)


You should see that the 'or' changes to a recognised 'Or' operator in the VBE screen.

Keep me updated, I will look at the parts 2 & 3 as soon as I can grab the time (I'm ususally at work when I'm on the forum!):devil2:
:thumb

Abi
06-02-2006, 02:45 AM
Hi Apps
When I used the line below it stops


While Left(x, 8) <> " COUNTRY" or Left(x, 5) <> " AREA" And Not EOF(FF)

referring to this line:

Line Input #FF, x

So now I'm thinking the problem is related to one of these sections:

Dim wsAll As Worksheet, wsCrit As Worksheet, wsNew As Worksheet
Dim LastRowCrit As Long, LastRow As Long, i As Long
Dim strPath As String, x As String, strCountry As String
Dim arrHeadings
Dim FF


strCountry = Mid(x, 11, 3)
While Left(x, "1") <> "-"
Line Input #FF, x

But I'm really just guessing. I hope I'm not too much of a hassle. It's just I've never tried to work with this specific type of macro before.