Consulting

Results 1 to 13 of 13

Thread: VBA code for text to column in 2002

  1. #1

    VBA code for text to column in 2002

    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

  2. #2
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    Moved to Excel Forum.

  3. #3
    Bump up for help. Here's the VBA code that was written for me:

    [vba]
    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
    [/vba]

  4. #4
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    Hi Abi,
    I can't access your data. Can you post it here?. Use Manage Attachments in the Go Advanced section.
    Regards
    MD
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  5. #5
    Quote Originally Posted by mdmackillop
    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.

  6. #6
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    Hi Abi,
    Try zipping your text file first.
    Regards
    MD
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  7. #7
    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...

  8. #8
    VBAX Regular Apps's Avatar
    Joined
    May 2006
    Posts
    38
    Location
    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.

    [vba]
    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
    [/vba]

    Hope this proves useful for you.

  9. #9
    VBAX Newbie
    Joined
    May 2006
    Posts
    4
    Location

    Trouble with Selected Items

    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

  10. #10
    VBAX Master Norie's Avatar
    Joined
    Jan 2005
    Location
    Stirling, Scotland
    Posts
    1,831
    Location
    lawrenb

    Is your question connected to this thread?

    If it isn't start a new one.

  11. #11
    Quote Originally Posted by Apps
    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...

  12. #12
    VBAX Regular Apps's Avatar
    Joined
    May 2006
    Posts
    38
    Location
    Hello again Abi,

    Glad the code worked ok for you.

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

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

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

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

    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!)

  13. #13
    Hi Apps
    When I used the line below it stops

    [vba]
    While Left(x, 8) <> " COUNTRY" or Left(x, 5) <> " AREA" And Not EOF(FF)
    [/vba]
    referring to this line:
    [vba]
    Line Input #FF, x
    [/vba]
    So now I'm thinking the problem is related to one of these sections:
    [vba]
    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
    [/vba]
    [vba]
    strCountry = Mid(x, 11, 3)
    While Left(x, "1") <> "-"
    Line Input #FF, x
    [/vba]
    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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •