|
Import long string (modified Tom O snippet help!)
Tom Ogilvy provided me with a fantastic snippet that imported in a similar
file. I have tried to modify the previous script to handle the new text file layout however i have been recieving a runtime error 1004 amongst others when i have been playing with this. I have put this basically back to orig snippet provided, with a couple of mods. Please can you guys just have a look over the script see if you can see the glaring mistakes i have made whilst trying to modify Tom's script. I have included some sample text at the end of the post . --------------------------------------------------------- Sub GETINVRPT() Dim FName As String Dim FNum As Long Dim l As String Dim l1 As Variant Dim s As String Dim sChr As String Dim rng1 As Range, rng As Range Dim cell As Range, iloc As Long Columns("A:E").ClearContents Columns(5).NumberFormat = _ "0000000000000" FName = "C:\INVRPT.txt" FNum = FreeFile Open FName For Input As FNum Line Input #FNum, s s = Application.Clean(s) s = Replace(s, Chr(9), "") l = s l = Replace(l, "LIN+", "LIN+,") l = Replace(l, "LOC", "LIN+LOC") l = Replace(l, ":EN'QTY+17:", ",") l = Replace(l, "::9'QTY+17:", ",") l = Replace(l, "::9'QTY+198:", ",") l = Replace(l, "::9'QTY+83:", ",") l = Replace(l, "'", "") ' l = Replace(l, "+", ",") l1 = Split(l, "LIN+") Cells(1, 1).Resize(UBound(l1) - _ LBound(l1) + 1).Value = Application. _ Transpose(l1) Close #FNum Rows(1).Delete Columns(1).Replace "++", "," Columns(1).TextToColumns _ Destination:=Range("A1"), _ 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)) Set rng1 = Cells(Rows.Count, 5).End(xlUp) iloc = InStr(1, rng1, "UN", vbTextCompare) rng1 = Left(rng1, iloc - 1) Set rng = Columns(1).SpecialCells(xlConstants) For Each cell In rng iloc = InStr(1, cell, "+", vbTextCompare) iloc = InStr(iloc + 1, cell, "+", vbTextCompare) cell.Value = "'" & Mid(cell, iloc + 1, 13) Next Set rng = Columns(1).SpecialCells(xlBlanks) rng.Formula = "=" & rng(1).Offset(-1, 0).Address(0, 0) Set rng = Range(Cells(1, 1), _ Cells(Rows.Count, 1).End(xlUp)) rng.Formula = rng.Value Set rng = Columns(2).SpecialCells(xlBlanks) rng.EntireRow.Delete Columns(2).Delete Rows(1).Insert Range("A1:E1").Value = _ Array("LOC", "EAN", "QTY17", "QTY198", "QTY83") Columns("A:E").AutoFit Range("A1").CurrentRegion.Name = "Database" End Sub ---------------------------------------------------------------------- Results i am after: LOC | EAN | QTY17 | QTY198 | QTY83 0000000000000 | 0000000000000 | 0 | 0 | 0 from a table in the above format i have already created a pivot with lookups to make a very readable report, Any help really appreciated. Brian --------------------------------------------------------------------------- Sample Text. Note: I cut ou a massive chunk in the middle but kept the format... UNB+UNOA:3+5023949000004:14+5014838000001+060205:0 513+436+ETRADING+INVRPT'UNH+23+INVRPT:D:96A:UN:EAN 008'BGM+35+00000009+9'DTM+366:20060204:102'NAD+BY+ 5023949000004::9'NAD+SU+5014838000001::9'LIN+1++21 298776:EN'QTY+17:1'LOC+14+5023949771634::9'QTY+198 :0'LOC +14+5023949771634::9'QTY+83:0'LOC+14+5023949771634 ::9'LIN+2++21326806:EN'QTY+17:3'LOC+14+50239490578 95::9'QTY+198:0'LOC+14+5023949057895::9'QTY+83:0'L OC+14+5023949057895::9'QTY+17:4'LOC+14+50239491367 74::9'QTY+198:0'LOC+14+5023949136774::9'QTY+83:0'L OC+14+ 5023949136774::9'QTY+17:2'LOC+14+5023949182579::9' QTY+198:0'LOC+14+5023949182579::9'QTY+83:0'LOC+14+ 5023949182579::9'QTY+17:5'LOC+14+5023949223920::9' QTY+198:0'LOC+14+5023949223920::9'QTY+83:0'LOC+14+ 5023949223920::9'QTY+17:4'LOC+14+5023949248730::9' QTY+19 8:0'LOC+14+5023949248730::9'QTY+83:0'LOC+14+502394 9248730::9'QTY+17:3'LOC+14+5023949294535::9'QTY+19 8:0'LOC+14+5023949294535::9'QTY+83:0'LOC+14+502394 9294535::9'QTY+17:3'LOC+14+5023949319342::9'QTY+19 8:0'LOC+14+5023949319342::9'QTY+83:0'LOC+14+502394 931934 2::9'QTY+17:4'LOC+14+5023949373414::9'QTY+198:0'LO C+14+5023949373414::9'QTY+83:0'LOC+14+502394937341 4::9'QTY+17:3'LOC+14+5023949374976::9'QTY+198:0'LO C+14+5023949374976::9'QTY+83:0'LOC+14+502394937497 6::9'QTY+17:1'LOC+14+5023949414768::9'QTY+198:0'LO C+14+5 023949414768::9'QTY+83:0'LOC+14+5023949414768::9'Q TY+17:3'LOC+14+5023949423933::9'QTY+198:0'LOC+14+5 023949423933::9'QTY+83:0'LOC+14+5023949423933::9'Q TY+17:3'LOC+14+5023949584122::9'QTY+198:0'LOC+14+5 023949584122::9'QTY+83:0'LOC+14+5023949584122::9'Q TY+17: 3'LOC+14+5023949670870::9'QTY+198:0'LOC+14+5023949 670870::9'QTY+83:0'LOC+14+5023949670870::9'QTY+17: 3'LOC+14+5023949692755::9'QTY+198:0'LOC+14+5023949 692755::9'QTY+83:0'LOC+14+5023949692755::9'QTY+17: 8'LOC+14+5023949771634::9'QTY+198:0'LOC+14+5023949 771634 ::9'QTY+83:0'LOC+14+5023949771634::9'QTY+17:7'LOC+ 18+5023949825700::9'QTY+17:4'LOC+14+5023949867056: :9'QTY+198:0'LOC+14+5023949867056::9'QTY+83:0'LOC+ 14+5023949867056::9'QTY+17:5'LOC+14+5023949929392: :9'QTY+198:0'LOC+14+5023949929392::9'QTY+83:0'LOC+ 14+502 3949929392::9'LIN+3++21348914:EN'QTY+17:1'LOC+14+5 023949248730::9'QTY+198:0'LOC+14+5023949248730::9' QTY+83:0'LOC+14+5023949248730::9'QTY+17:2'LOC+14+5 023949319342::9'QTY+198:0'LOC+14+5023949319342::9' QTY+83:0'LOC+14+5023949319342::9'LIN+4++21381416:E N'QTY+ 17:1'LOC+14+5023949182579::9'QTY+198:0'LOC+14+5023 949182579::9'QTY+83:0'LOC+14+5023949182579::9'LIN+ 5++21481499:EN'QTY+17:1'LOC+14+5023949057895::9'QT Y+198:0'LOC+14+5023949057895::9'QTY+83:0'LOC+14+50 23949057895::9'QTY+17:1'LOC+14+5023949373414::9'QT Y+198: 0'LOC+14+5023949373414::9'QTY+83:0'LOC+14+50239493 73414::9'LIN+6++21481505:EN'QTY+17:1'LOC+14+502394 9057895::9'QTY+198:0'LOC+14+5023949057895::9'QTY+8 3:0'LOC+14+5023949057895::9'QTY+17:2'LOC+14+502394 9771634::9'QTY+198:0'LOC+14+5023949771634::9'QTY+8 3:0'LO C+14+5023949771634::9'LIN+7++21481512:EN'QTY+17:1' LOC+14+5023949057895::9'QTY+198:0'LOC+14+502394905 7895::9'QTY+83:0'LOC+14+5023949057895::9'QTY+17:3' LOC+14+5023949145040::9'QTY+198:0'LOC+14+502394914 5040::9'QTY+83:0'LOC+14+5023949145040::9'QTY+17:1' LOC+14 +5023949670870::9'QTY+198:0'LOC+14+5023949670870:: 9'QTY+83:0'LOC+14+5023949670870::9'QTY+17:1'LOC+14 +5023949701028::9'QTY+198:0'LOC+14+5023949701028:: 9'QTY+83:0'LOC+14+5023949701028::9'QTY+17:1'LOC+14 +5023949771634::9'QTY+198:0'LOC+14+5023949771634:: 9'QTY+ 83:0'LOC+14+5023949771634::9'QTY+17:1'LOC+14+50239 49832131::9'QTY+198:0'LOC+14+5023949832131::9'QTY+ 83:0'LOC+14+5023949832131::9'LIN+8++21481529:EN'QT Y+17:2'LOC+14+5023949223920::9'QTY+198:0'LOC+14+50 23949223920::9'QTY+83:0'LOC+14+5023949223920::9'QT Y+17:1 'LOC+14+5023949374976::9'QTY+198:0'LOC+14+50239493 74976::9'QTY+83:0'LOC+14+5023949374976::9'QTY+17:1 'LOC+14+5023949832131::9'QTY+198:0'LOC+14+50239498 32131::9'QTY+83:0'LOC+14+5023949832131::9'LIN+9++2 1493393:EN'QTY+17:1'LOC+14+5023949049625::9'QTY+19 8:0'LO C+14+5023949049625::9'QTY+83:0'LOC+14+502394904962 5::9'LIN+10++5014838064023:EN'QTY+17:5'LOC+14+5023 949049625::9'QTY+198:0'LOC+14+5023949049625::9'QTY +83:0'LOC+14+5023949049625::9'QTY+17:5'LOC+14+5023 949057895::9'QTY+198:0'LOC+14+5023949057895::9'QTY +83:0' LOC+14+5023949057895::9'QTY+17:5'LOC+14+5023949136 774::9'QTY+198:0'LOC+14+5023949136774::9'QTY+83:0' LOC+14+5023949136774::9'QTY+17:2'LOC+14+5023949145 040::9'QTY+198:1'LOC+14+5023949145040::9'QTY+83:0' LOC+14+5023949145040::9'QTY+17:11'LOC+14+502394918 2579:: 9'QTY+198:0'LOC+14+5023949182579::9'QTY+83:0'LOC+1 4+5023949182579::9'QTY+17:2'LOC+14+5023949223920:: 9'QTY+198:0'LOC+14+5023949223920::9'QTY+83:0'LOC+1 4+5023949223920::9'QTY+17:5'LOC+14+5023949232199:: 9'QTY+198:0'LOC+14+5023949232199::9'QTY+83:0'LOC+1 4+5023 949232199::9'QTY+17:5'LOC+14+5023949248730::9'QTY+ 198:0'LOC+14+5023949248730::9'QTY+83:0'LOC+14+5023 949248730::9'QTY+17:11'LOC+14+5023949294535::9'QTY +198:2'LOC+14+5023949294535::9'QTY+83:0'LOC+14+502 3949294535::9'QTY+17:5'LOC+14+5023949319342::9'QTY +198:0 'LOC+14+5023949319342::9'QTY+83:0'LOC+14+502394931 9342::9'QTY+17:4'LOC+14+5023949327619::9'QTY+198:0 'LOC+14+5023949327619::9'QTY+83:0'LOC+14+502394932 7619::9'QTY+17:5'LOC+14+5023949373414::9'QTY+198:0 'LOC+14+5023949373414::9'QTY+83:0'LOC+14+502394937 3414:: 9'QTY+17:5'LOC+14+5023949374976::9'QTY+198:0'LOC+1 4+5023949374976::9'QTY+83:0'LOC+14+5023949374976:: 9'QTY+17:3'LOC+14+5023949414768::9'QTY+198:0'LOC+1 4+5023949414768::9'QTY+83:0'LOC+14+5023949414768:: 9'QTY+17:5'LOC+14+5023949423933::9'QTY+198:0'LOC+1 4+5023 949423933::9'QTY+83:0'LOC+14+5023949423933::9'QTY+ 17:4'LOC+14+5023949510183::9'QTY+198:0'LOC+14+5023 949510183::9'QTY+83:0'LOC+14+5023949510183::9'QTY+ 17:5'LOC+14+5023949511753::9'QTY+198:0'LOC+14+5023 949511753::9'QTY+83:0'LOC+14+5023949511753::9'QTY+ 17:3'L OC+14+5023949584122::9'QTY+198:0'LOC+14+5023949584 122::9'QTY+83:0'LOC+14+5023949584122::9'QTY+17:5'L OC+14+5023949597339::9'QTY+198:0'LOC+14+5023949597 339::9'QTY+83:0'LOC+14+5023949597339::9'QTY+17:5'L OC+14+5023949670870::9'QTY+198:0'LOC+14+5023949670 870::9 'QTY+83:0'LOC+14+5023949670870::9'QTY+17:5'LOC+14+ 5023949692755::9'QTY+198:0'LOC+14+5023949692755::9 'QTY+83:0'LOC+14+5023949692755::9'QTY+17:5'LOC+14+ 5023949701028::9'QTY+198:0'LOC+14+5023949701028::9 'QTY+83:0'LOC+14+5023949701028::9'QTY+17:6'LOC+14+ 502394 9771634::9'QTY+198:0'LOC+14+5023949771634::9'QTY+8 3:0'LOC+14+5023949771634::9'QTY+17:5'LOC+14+502394 9832131::9'QTY+198:0'LOC+14+5023949832131::9'QTY+8 3:0'LOC+14+5023949832131::9'QTY+17:5'LOC+14+502394 9833970::9'QTY+198:0'LOC+14+5023949833970::9'QTY+8 3:0'LO C+14+5023949833970::9'QTY+17:6'LOC+14+502394984330 4::9'QTY+198:0'LOC+14+5023949843304::9'QTY+83:0'LO C+14+5023949843304::9'QTY+17:1'LOC+14+502394986705 6::9'QTY+198:2'LOC+14+5023949867056::9'QTY+83:0'LO C+14+5023949867056::9'QTY+17:5'LOC+14+502394991285 9::9'Q TY+198:0'LOC+14+5023949912859::9'QTY+83:0'LOC+14+5 023949912859::9'QTY+17:4'LOC+14+5023949929392::9'Q TY+198:0'LOC+14+5023949929392::9'QTY+83:0'LOC+14+5 023949929392::9'QTY+17:5'LOC+14+5023949955601::9'Q TY+198:0'LOC+14+5023949955601::9'QTY+83:0'LOC+14+5 023949 955601::9'QTY+17:5'LOC+14+5023949962472::9'QTY+198 :1'LOC+14+5023949962472::9'QTY+83:0'LOC+14+5023949 962472::9'LIN+11++5014838066317:EN'QTY+17:2'LOC+14 +5023949057895::9'QTY+198:0'LOC+14+5023949057895:: 9'QTY+83:0'LOC+14+5023949057895::9'QTY+17:1'LOC+14 +50239 49136774::9'QTY+198:0'LOC+14+5023949136774::9'QTY+ 83:0'LOC+14+5023949136774::9'QTY+17:1'LOC+14+50239 49182579::9'QTY+198:0'LOC+14+5023949182579::9'QTY+ 83:0'LOC+14+5023949182579::9'QTY+17:1'LOC+14+50239 49223920::9'QTY+198:0'LOC+14+5023949223920::9'QTY+ 83:0'L OC+14+5023949223920::9'QTY+17:3'LOC+14+50239492487 30::9'QTY+198:0'LOC+14+5023949248730::9'QTY+83:0'L OC+14+5023949248730::9'QTY+17:3'LOC+14+50239493734 14::9'QTY+198:0'LOC+14+5023949373414::9'QTY+83:0'L OC+14+5023949373414::9'QTY+17:1'LOC+14+50239493749 76::9' QTY+198:0'LOC+14+5023949374976::9'QTY+83:0'LOC+14+ 5023949374976::9'QTY+17:1'LOC+14+5023949423933::9' QTY+198:0'LOC+14+5023949423933::9'QTY+83:0'LOC+14+ 5023949423933::9'QTY+17:3'LOC+14+5023949511753::9' QTY+198:0'LOC+14+5023949511753::9'QTY+83:0'LOC+14+ 502394 9511753::9'QTY+17:2'LOC+14+5023949584122::9'QTY+19 8:0'LOC+14+5023949584122::9'QTY+83:0'LOC+14+502394 9584122::9'QTY+17:1'LOC+14+5023949597339::9'QTY+19 8:0'LOC+14+5023949597339::9'QTY+83:0'LOC+14+502394 9597339::9'QTY+17:4'LOC+14+5023949764661::9'QTY+19 8:0'LO C+14+5023949764661::9'QTY+83:0'LOC+14+502394976466 1::9'QTY+17:3'LOC+14+5023949771634::9'QTY+198:0'LO C+14+5023949771634::9'QTY+83:0'LOC+14+502394977163 4::9'QTY+17:1'LOC+14+5023949833970::9'QTY+198:0'LO C+14+5023949833970::9'QTY+83:0'LOC+14+502394983397 0::9'Q TY+17:1'LOC+14+5023949867056::9'QTY+198:0'LOC+14+5 023949867056::9'QTY+83:0'LOC+14+5023949867056::9'Q TY+17:1'LOC+14+5023949929392::9'QTY+198:0'LOC+14+5 023949929392::9'QTY+83:0'LOC+14+5023949929392::9'Q TY+17:1'LOC+14+5023949962472::9'QTY+198:0'LOC+14+5 023949 962472::9'QTY+83:0'LOC+14+5023949962472::9'LIN+129 ++5014838370384:EN'QTY+17:1'LOC+14+5023949182579:: 9'QTY+198:0'LOC+14+5023949182579::9'QTY+83:0'LOC+1 4+5023949182579::9'QTY+17:2'LOC+14+5023949670870:: 9'QTY+198:0'LOC+14+5023949670870::9'QTY+83:1'LOC+1 4+5023949670870::9'QTY+17:2'LOC+1 4+5023949867056::9'QTY+198:0'LOC+14+5023949867056: :9'QTY+83:0'LOC+14+5023949867056::9'LIN+130++50148 38370414:EN'QTY+17:2'LOC+14+5023949145040::9'QTY+1 98:0'LOC+14+5023949145040::9'QTY+83:0'LOC+14+50239 49145040::9'QTY+17:1'LOC+14+5023949327619::9'QTY+1 98:0'L OC+14+5023949327619::9'QTY+83:0'LOC+14+50239493276 19::9'QTY+17:1'LOC+14+5023949584122::9'QTY+198:0'L OC+14+5023949584122::9'QTY+83:0'LOC+14+50239495841 22::9'QTY+17:2'LOC+14+5023949670870::9'QTY+198:0'L OC+14+5023949670870::9'QTY+83:0'LOC+14+50239496708 70::9' QTY+17:1'LOC+14+5023949929392::9'QTY+198:0'LOC+14+ 5023949929392::9'QTY+83:0'LOC+14+5023949929392::9' LIN+131++5014838370438:EN'QTY+17:0'LOC+14+50239493 19342::9'QTY+198:0'LOC+14+5023949319342::9'QTY+83: 2'LOC+14+5023949319342::9'UNT+15237+23'UNZ+1+436' |
Import long string (modified Tom O snippet help!)
This does the first part of the processing. However, it isn't as clean as
the other file. The lines that end up with a form like: +14+5023949771634::9 and originate as 'LOC+14+5023949771634::9' It is not clear what to do with them. they appear at the end of the LIN group and would normally be QTY+17 if they followed the pattern. The 17 type lines that have the format EN'QTY+17:3 are found at the end of the LIN lines. So, not clear what to do with the Number after the ":" (3 in the above example). Anyway, run this macro against your file and see what I mean: Sub testme3() Dim FName As String Dim FNum As Long Dim l As String Dim l1 As Variant Dim s As String Dim sChr As String Dim rng1 As Range, rng As Range Dim cell As Range, iloc As Long Columns("A:D").ClearContents Columns(3).NumberFormat = _ "0000000000000" FName = "C:\SLSRPT2.txt" FNum = FreeFile Open FName For Input As FNum Line Input #FNum, s s = Application.Clean(s) s = Replace(s, Chr(9), "") l = s l = Replace(l, "LIN+", "LIN+,") l = Replace(l, "LOC", "LIN+,,") l = Replace(l, ":EN'QTY+17:", ",") l = Replace(l, "::9'QTY+17:", ",17,") l = Replace(l, "::9'QTY+83:", ",83,") l = Replace(l, "::9'QTY+198:", ",198,") l = Replace(l, "'", "") ' l = Replace(l, "+", ",") l1 = Split(l, "LIN+") Cells(1, 1).Resize(UBound(l1) - _ LBound(l1) + 1).Value = Application. _ Transpose(l1) Close #FNum Rows(1).Delete Columns(1).Replace "++", "," Columns(1).TextToColumns _ Destination:=Range("A1"), _ 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)) Set rng2 = Range(Cells(1, 2), _ Cells(Rows.Count, 2).End(xlUp)) For Each cell In rng2.SpecialCells(xlConstants) cell.Offset(0, -1).Delete Shift:=xlShiftToLeft Next End Sub -- Regards, Tom Ogilvy "Brian" wrote in message ... Tom Ogilvy provided me with a fantastic snippet that imported in a similar file. I have tried to modify the previous script to handle the new text file layout however i have been recieving a runtime error 1004 amongst others when i have been playing with this. I have put this basically back to orig snippet provided, with a couple of mods. Please can you guys just have a look over the script see if you can see the glaring mistakes i have made whilst trying to modify Tom's script. I have included some sample text at the end of the post . --------------------------------------------------------- Sub GETINVRPT() Dim FName As String Dim FNum As Long Dim l As String Dim l1 As Variant Dim s As String Dim sChr As String Dim rng1 As Range, rng As Range Dim cell As Range, iloc As Long Columns("A:E").ClearContents Columns(5).NumberFormat = _ "0000000000000" FName = "C:\INVRPT.txt" FNum = FreeFile Open FName For Input As FNum Line Input #FNum, s s = Application.Clean(s) s = Replace(s, Chr(9), "") l = s l = Replace(l, "LIN+", "LIN+,") l = Replace(l, "LOC", "LIN+LOC") l = Replace(l, ":EN'QTY+17:", ",") l = Replace(l, "::9'QTY+17:", ",") l = Replace(l, "::9'QTY+198:", ",") l = Replace(l, "::9'QTY+83:", ",") l = Replace(l, "'", "") ' l = Replace(l, "+", ",") l1 = Split(l, "LIN+") Cells(1, 1).Resize(UBound(l1) - _ LBound(l1) + 1).Value = Application. _ Transpose(l1) Close #FNum Rows(1).Delete Columns(1).Replace "++", "," Columns(1).TextToColumns _ Destination:=Range("A1"), _ 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)) Set rng1 = Cells(Rows.Count, 5).End(xlUp) iloc = InStr(1, rng1, "UN", vbTextCompare) rng1 = Left(rng1, iloc - 1) Set rng = Columns(1).SpecialCells(xlConstants) For Each cell In rng iloc = InStr(1, cell, "+", vbTextCompare) iloc = InStr(iloc + 1, cell, "+", vbTextCompare) cell.Value = "'" & Mid(cell, iloc + 1, 13) Next Set rng = Columns(1).SpecialCells(xlBlanks) rng.Formula = "=" & rng(1).Offset(-1, 0).Address(0, 0) Set rng = Range(Cells(1, 1), _ Cells(Rows.Count, 1).End(xlUp)) rng.Formula = rng.Value Set rng = Columns(2).SpecialCells(xlBlanks) rng.EntireRow.Delete Columns(2).Delete Rows(1).Insert Range("A1:E1").Value = _ Array("LOC", "EAN", "QTY17", "QTY198", "QTY83") Columns("A:E").AutoFit Range("A1").CurrentRegion.Name = "Database" End Sub ---------------------------------------------------------------------- Results i am after: LOC | EAN | QTY17 | QTY198 | QTY83 0000000000000 | 0000000000000 | 0 | 0 | 0 from a table in the above format i have already created a pivot with lookups to make a very readable report, Any help really appreciated. Brian -------------------------------------------------------------------------- - Sample Text. Note: I cut ou a massive chunk in the middle but kept the format... UNB+UNOA:3+5023949000004:14+5014838000001+060205:0 513+436+ETRADING+INVRPT'UN H+23+INVRPT:D:96A:UN:EAN008'BGM+35+00000009+9'DTM+ 366:20060204:102'NAD+BY+50 23949000004::9'NAD+SU+5014838000001::9'LIN+1++2129 8776:EN'QTY+17:1'LOC+14+50 23949771634::9'QTY+198:0'LOC +14+5023949771634::9'QTY+83:0'LOC+14+5023949771634 ::9'LIN+2++21326806:EN'QTY +17:3'LOC+14+5023949057895::9'QTY+198:0'LOC+14+502 3949057895::9'QTY+83:0'LOC +14+5023949057895::9'QTY+17:4'LOC+14+5023949136774 ::9'QTY+198:0'LOC+14+50239 49136774::9'QTY+83:0'LOC+14+ 5023949136774::9'QTY+17:2'LOC+14+5023949182579::9' QTY+198:0'LOC+14+502394918 2579::9'QTY+83:0'LOC+14+5023949182579::9'QTY+17:5' LOC+14+5023949223920::9'QT Y+198:0'LOC+14+5023949223920::9'QTY+83:0'LOC+14+50 23949223920::9'QTY+17:4'LO C+14+5023949248730::9'QTY+19 8:0'LOC+14+5023949248730::9'QTY+83:0'LOC+14+502394 9248730::9'QTY+17:3'LOC+14 +5023949294535::9'QTY+198:0'LOC+14+5023949294535:: 9'QTY+83:0'LOC+14+50239492 94535::9'QTY+17:3'LOC+14+5023949319342::9'QTY+198: 0'LOC+14+5023949319342::9' QTY+83:0'LOC+14+502394931934 2::9'QTY+17:4'LOC+14+5023949373414::9'QTY+198:0'LO C+14+5023949373414::9'QTY+ 83:0'LOC+14+5023949373414::9'QTY+17:3'LOC+14+50239 49374976::9'QTY+198:0'LOC+ 14+5023949374976::9'QTY+83:0'LOC+14+5023949374976: :9'QTY+17:1'LOC+14+5023949 414768::9'QTY+198:0'LOC+14+5 023949414768::9'QTY+83:0'LOC+14+5023949414768::9'Q TY+17:3'LOC+14+50239494239 33::9'QTY+198:0'LOC+14+5023949423933::9'QTY+83:0'L OC+14+5023949423933::9'QTY +17:3'LOC+14+5023949584122::9'QTY+198:0'LOC+14+502 3949584122::9'QTY+83:0'LOC +14+5023949584122::9'QTY+17: 3'LOC+14+5023949670870::9'QTY+198:0'LOC+14+5023949 670870::9'QTY+83:0'LOC+14+ 5023949670870::9'QTY+17:3'LOC+14+5023949692755::9' QTY+198:0'LOC+14+502394969 2755::9'QTY+83:0'LOC+14+5023949692755::9'QTY+17:8' LOC+14+5023949771634::9'QT Y+198:0'LOC+14+5023949771634 ::9'QTY+83:0'LOC+14+5023949771634::9'QTY+17:7'LOC+ 18+5023949825700::9'QTY+17 :4'LOC+14+5023949867056::9'QTY+198:0'LOC+14+502394 9867056::9'QTY+83:0'LOC+14 +5023949867056::9'QTY+17:5'LOC+14+5023949929392::9 'QTY+198:0'LOC+14+50239499 29392::9'QTY+83:0'LOC+14+502 3949929392::9'LIN+3++21348914:EN'QTY+17:1'LOC+14+5 023949248730::9'QTY+198:0' LOC+14+5023949248730::9'QTY+83:0'LOC+14+5023949248 730::9'QTY+17:2'LOC+14+502 3949319342::9'QTY+198:0'LOC+14+5023949319342::9'QT Y+83:0'LOC+14+502394931934 2::9'LIN+4++21381416:EN'QTY+ 17:1'LOC+14+5023949182579::9'QTY+198:0'LOC+14+5023 949182579::9'QTY+83:0'LOC+ 14+5023949182579::9'LIN+5++21481499:EN'QTY+17:1'LO C+14+5023949057895::9'QTY+ 198:0'LOC+14+5023949057895::9'QTY+83:0'LOC+14+5023 949057895::9'QTY+17:1'LOC+ 14+5023949373414::9'QTY+198: 0'LOC+14+5023949373414::9'QTY+83:0'LOC+14+50239493 73414::9'LIN+6++21481505:E N'QTY+17:1'LOC+14+5023949057895::9'QTY+198:0'LOC+1 4+5023949057895::9'QTY+83: 0'LOC+14+5023949057895::9'QTY+17:2'LOC+14+50239497 71634::9'QTY+198:0'LOC+14+ 5023949771634::9'QTY+83:0'LO C+14+5023949771634::9'LIN+7++21481512:EN'QTY+17:1' LOC+14+5023949057895::9'QT Y+198:0'LOC+14+5023949057895::9'QTY+83:0'LOC+14+50 23949057895::9'QTY+17:3'LO C+14+5023949145040::9'QTY+198:0'LOC+14+50239491450 40::9'QTY+83:0'LOC+14+5023 949145040::9'QTY+17:1'LOC+14 +5023949670870::9'QTY+198:0'LOC+14+5023949670870:: 9'QTY+83:0'LOC+14+50239496 70870::9'QTY+17:1'LOC+14+5023949701028::9'QTY+198: 0'LOC+14+5023949701028::9' QTY+83:0'LOC+14+5023949701028::9'QTY+17:1'LOC+14+5 023949771634::9'QTY+198:0' LOC+14+5023949771634::9'QTY+ 83:0'LOC+14+5023949771634::9'QTY+17:1'LOC+14+50239 49832131::9'QTY+198:0'LOC+ 14+5023949832131::9'QTY+83:0'LOC+14+5023949832131: :9'LIN+8++21481529:EN'QTY+ 17:2'LOC+14+5023949223920::9'QTY+198:0'LOC+14+5023 949223920::9'QTY+83:0'LOC+ 14+5023949223920::9'QTY+17:1 'LOC+14+5023949374976::9'QTY+198:0'LOC+14+50239493 74976::9'QTY+83:0'LOC+14+5 023949374976::9'QTY+17:1'LOC+14+5023949832131::9'Q TY+198:0'LOC+14+5023949832 131::9'QTY+83:0'LOC+14+5023949832131::9'LIN+9++214 93393:EN'QTY+17:1'LOC+14+5 023949049625::9'QTY+198:0'LO C+14+5023949049625::9'QTY+83:0'LOC+14+502394904962 5::9'LIN+10++5014838064023 :EN'QTY+17:5'LOC+14+5023949049625::9'QTY+198:0'LOC +14+5023949049625::9'QTY+8 3:0'LOC+14+5023949049625::9'QTY+17:5'LOC+14+502394 9057895::9'QTY+198:0'LOC+1 4+5023949057895::9'QTY+83:0' LOC+14+5023949057895::9'QTY+17:5'LOC+14+5023949136 774::9'QTY+198:0'LOC+14+50 23949136774::9'QTY+83:0'LOC+14+5023949136774::9'QT Y+17:2'LOC+14+502394914504 0::9'QTY+198:1'LOC+14+5023949145040::9'QTY+83:0'LO C+14+5023949145040::9'QTY+ 17:11'LOC+14+5023949182579:: 9'QTY+198:0'LOC+14+5023949182579::9'QTY+83:0'LOC+1 4+5023949182579::9'QTY+17: 2'LOC+14+5023949223920::9'QTY+198:0'LOC+14+5023949 223920::9'QTY+83:0'LOC+14+ 5023949223920::9'QTY+17:5'LOC+14+5023949232199::9' QTY+198:0'LOC+14+502394923 2199::9'QTY+83:0'LOC+14+5023 949232199::9'QTY+17:5'LOC+14+5023949248730::9'QTY+ 198:0'LOC+14+5023949248730 ::9'QTY+83:0'LOC+14+5023949248730::9'QTY+17:11'LOC +14+5023949294535::9'QTY+1 98:2'LOC+14+5023949294535::9'QTY+83:0'LOC+14+50239 49294535::9'QTY+17:5'LOC+1 4+5023949319342::9'QTY+198:0 'LOC+14+5023949319342::9'QTY+83:0'LOC+14+502394931 9342::9'QTY+17:4'LOC+14+50 23949327619::9'QTY+198:0'LOC+14+5023949327619::9'Q TY+83:0'LOC+14+50239493276 19::9'QTY+17:5'LOC+14+5023949373414::9'QTY+198:0'L OC+14+5023949373414::9'QTY +83:0'LOC+14+5023949373414:: 9'QTY+17:5'LOC+14+5023949374976::9'QTY+198:0'LOC+1 4+5023949374976::9'QTY+83: 0'LOC+14+5023949374976::9'QTY+17:3'LOC+14+50239494 14768::9'QTY+198:0'LOC+14+ 5023949414768::9'QTY+83:0'LOC+14+5023949414768::9' QTY+17:5'LOC+14+5023949423 933::9'QTY+198:0'LOC+14+5023 949423933::9'QTY+83:0'LOC+14+5023949423933::9'QTY+ 17:4'LOC+14+5023949510183: :9'QTY+198:0'LOC+14+5023949510183::9'QTY+83:0'LOC+ 14+5023949510183::9'QTY+17 :5'LOC+14+5023949511753::9'QTY+198:0'LOC+14+502394 9511753::9'QTY+83:0'LOC+14 +5023949511753::9'QTY+17:3'L OC+14+5023949584122::9'QTY+198:0'LOC+14+5023949584 122::9'QTY+83:0'LOC+14+502 3949584122::9'QTY+17:5'LOC+14+5023949597339::9'QTY +198:0'LOC+14+502394959733 9::9'QTY+83:0'LOC+14+5023949597339::9'QTY+17:5'LOC +14+5023949670870::9'QTY+1 98:0'LOC+14+5023949670870::9 'QTY+83:0'LOC+14+5023949670870::9'QTY+17:5'LOC+14+ 5023949692755::9'QTY+198:0 'LOC+14+5023949692755::9'QTY+83:0'LOC+14+502394969 2755::9'QTY+17:5'LOC+14+50 23949701028::9'QTY+198:0'LOC+14+5023949701028::9'Q TY+83:0'LOC+14+50239497010 28::9'QTY+17:6'LOC+14+502394 9771634::9'QTY+198:0'LOC+14+5023949771634::9'QTY+8 3:0'LOC+14+5023949771634:: 9'QTY+17:5'LOC+14+5023949832131::9'QTY+198:0'LOC+1 4+5023949832131::9'QTY+83: 0'LOC+14+5023949832131::9'QTY+17:5'LOC+14+50239498 33970::9'QTY+198:0'LOC+14+ 5023949833970::9'QTY+83:0'LO C+14+5023949833970::9'QTY+17:6'LOC+14+502394984330 4::9'QTY+198:0'LOC+14+5023 949843304::9'QTY+83:0'LOC+14+5023949843304::9'QTY+ 17:1'LOC+14+5023949867056: :9'QTY+198:2'LOC+14+5023949867056::9'QTY+83:0'LOC+ 14+5023949867056::9'QTY+17 :5'LOC+14+5023949912859::9'Q TY+198:0'LOC+14+5023949912859::9'QTY+83:0'LOC+14+5 023949912859::9'QTY+17:4'L OC+14+5023949929392::9'QTY+198:0'LOC+14+5023949929 392::9'QTY+83:0'LOC+14+502 3949929392::9'QTY+17:5'LOC+14+5023949955601::9'QTY +198:0'LOC+14+502394995560 1::9'QTY+83:0'LOC+14+5023949 955601::9'QTY+17:5'LOC+14+5023949962472::9'QTY+198 :1'LOC+14+5023949962472::9 'QTY+83:0'LOC+14+5023949962472::9'LIN+11++50148380 66317:EN'QTY+17:2'LOC+14+5 023949057895::9'QTY+198:0'LOC+14+5023949057895::9' QTY+83:0'LOC+14+5023949057 895::9'QTY+17:1'LOC+14+50239 49136774::9'QTY+198:0'LOC+14+5023949136774::9'QTY+ 83:0'LOC+14+5023949136774: :9'QTY+17:1'LOC+14+5023949182579::9'QTY+198:0'LOC+ 14+5023949182579::9'QTY+83 :0'LOC+14+5023949182579::9'QTY+17:1'LOC+14+5023949 223920::9'QTY+198:0'LOC+14 +5023949223920::9'QTY+83:0'L OC+14+5023949223920::9'QTY+17:3'LOC+14+50239492487 30::9'QTY+198:0'LOC+14+502 3949248730::9'QTY+83:0'LOC+14+5023949248730::9'QTY +17:3'LOC+14+5023949373414 ::9'QTY+198:0'LOC+14+5023949373414::9'QTY+83:0'LOC +14+5023949373414::9'QTY+1 7:1'LOC+14+5023949374976::9' QTY+198:0'LOC+14+5023949374976::9'QTY+83:0'LOC+14+ 5023949374976::9'QTY+17:1' LOC+14+5023949423933::9'QTY+198:0'LOC+14+502394942 3933::9'QTY+83:0'LOC+14+50 23949423933::9'QTY+17:3'LOC+14+5023949511753::9'QT Y+198:0'LOC+14+50239495117 53::9'QTY+83:0'LOC+14+502394 9511753::9'QTY+17:2'LOC+14+5023949584122::9'QTY+19 8:0'LOC+14+5023949584122:: 9'QTY+83:0'LOC+14+5023949584122::9'QTY+17:1'LOC+14 +5023949597339::9'QTY+198: 0'LOC+14+5023949597339::9'QTY+83:0'LOC+14+50239495 97339::9'QTY+17:4'LOC+14+5 023949764661::9'QTY+198:0'LO C+14+5023949764661::9'QTY+83:0'LOC+14+502394976466 1::9'QTY+17:3'LOC+14+50239 49771634::9'QTY+198:0'LOC+14+5023949771634::9'QTY+ 83:0'LOC+14+5023949771634: :9'QTY+17:1'LOC+14+5023949833970::9'QTY+198:0'LOC+ 14+5023949833970::9'QTY+83 :0'LOC+14+5023949833970::9'Q TY+17:1'LOC+14+5023949867056::9'QTY+198:0'LOC+14+5 023949867056::9'QTY+83:0'L OC+14+5023949867056::9'QTY+17:1'LOC+14+50239499293 92::9'QTY+198:0'LOC+14+502 3949929392::9'QTY+83:0'LOC+14+5023949929392::9'QTY +17:1'LOC+14+5023949962472 ::9'QTY+198:0'LOC+14+5023949 962472::9'QTY+83:0'LOC+14+5023949962472::9'LIN+129 ++5014838370384:EN'QTY+17: 1'LOC+14+5023949182579::9'QTY+198:0'LOC+14+5023949 182579::9'QTY+83:0'LOC+14+ 5023949182579::9'QTY+17:2'LOC+14+5023949670870::9' QTY+198:0'LOC+14+502394967 0870::9'QTY+83:1'LOC+14+5023949670870::9'QTY+17:2' LOC+1 4+5023949867056::9'QTY+198:0'LOC+14+5023949867056: :9'QTY+83:0'LOC+14+5023949 867056::9'LIN+130++5014838370414:EN'QTY+17:2'LOC+1 4+5023949145040::9'QTY+198 :0'LOC+14+5023949145040::9'QTY+83:0'LOC+14+5023949 145040::9'QTY+17:1'LOC+14+ 5023949327619::9'QTY+198:0'L OC+14+5023949327619::9'QTY+83:0'LOC+14+50239493276 19::9'QTY+17:1'LOC+14+5023 949584122::9'QTY+198:0'LOC+14+5023949584122::9'QTY +83:0'LOC+14+5023949584122 ::9'QTY+17:2'LOC+14+5023949670870::9'QTY+198:0'LOC +14+5023949670870::9'QTY+8 3:0'LOC+14+5023949670870::9' QTY+17:1'LOC+14+5023949929392::9'QTY+198:0'LOC+14+ 5023949929392::9'QTY+83:0' LOC+14+5023949929392::9'LIN+131++5014838370438:EN' QTY+17:0'LOC+14+5023949319 342::9'QTY+198:0'LOC+14+5023949319342::9'QTY+83:2' LOC+14+5023949319342::9'UN T+15237+23'UNZ+1+436' |
Import long string (modified Tom O snippet help!)
Hi Tom,
Yes see what you mean... i ran the script and it produced a Run-time error '1004': Application-defined or object defined error This was the same as i was getting after fiddling with the last script; i did however comment out the 's = Application.Clean(s) line which then appeared to populate the data. i am now getting A = LIN NO (Not required) B = EAN (getting a value in Column C next to EAN which i am not sure what that is from...) C = LOC (=14+5023949057895 which obviously produces 5023949057909 so would have to kill the '=14+', also some have '::9' at the end) D = QTY (198, 83, 17) - the LOC code is listed 3 times (for the QTY types.) E = Value of Qty (198, 83, 17) ideally i want to get A = LOC (which is the 13 digit LOC code) B = EAN (which is the 13 digit EAN Code) C = Qty17 value D = Qty198 Value E = Qty83 Value This does the first part of the processing. However, it isn't as clean as the other file. The lines that end up with a form like: +14+5023949771634::9 < this is the LOC code which i would just want to display like 5023949771634 and originate as 'LOC+14+5023949771634::9' It is not clear what to do with them. they appear at the end of the LIN group and would normally be QTY+17 if they followed the pattern. The 17 type lines that have the format < YES SEE WHAT YOU MEAN - THAT SEEMS BE NOT RELATED TO ANY LOC ???? SO I WOULD KILL THAT VALUE AND ONLY USE OTHER QTY17s FOR EACH LOC EN'QTY+17:3 ::9'QTY+17: < if the QTY17 is a LOC following on from a LOC :EN'QTY+17: < if the Qty17 is the first LOC of a LIN ? ummmmmmmm are found at the end of the LIN lines. So, not clear what to do with the Number after the ":" (3 in the above example). Ditch it i think, go with the ones associated to the LOCs In the first part of this line for example (LIN+10) A| B | C | D | E EAN | LOC | QTY198 |QTY83 | QTY17 5014838064023 | 5023949049625 | 0 | 0 | 5 Sample LIN+10 LIN+10++5014838064023:EN'QTY+17:5'LOC+14+502394904 9625::9'QTY+198:0'LOC+14+5023949049625::9'QTY+83:0 'LOC+14+5023949049625::9'QTY+17:5'LOC+14+502394905 7895::9'QTY+198:0'LOC+14+5023949057895::9'QTY+83:0 'LOC+14+5023949057895::9'QTY+17:5'LOC+14+502394913 6774::9'QTY+198:0'LOC+14+5023949136774::9'QTY+83:0 'LOC+14+5023949136774::9'QTY+17:1'LOC+14+502394914 5040::9'QTY+198:2'LOC+14+5023949145040::9'QTY+83:0 'LOC+14+5023949145040::9'QTY+17:12'LOC+14+50239491 82579::9'QTY+198:0'LOC+14+5023949182579::9'QTY+83: 0'LOC+14+5023949182579::9'QTY+17:3'LOC+14+50239492 23920::9'QTY+198:2'LOC+14+5023949223920::9'QTY+83: 0'LOC+14+5023949223920::9'QTY+17:5'LOC+14+50239492 32199::9'QTY+198:0'LOC+14+5023949232199::9'QTY+83: 0'LOC+14+5023949232199::9'QTY+17:6'LOC+14+50239492 48730::9'QTY+198:0'LOC+14+5023949248730::9'QTY+83: 0'LOC+14+5023949248730::9'QTY+17:8'LOC+14+50239492 94535::9'QTY+198:4'LOC+14+5023949294535::9'QTY+83: 0'LOC+14+5023949294535::9'QTY+17:5'LOC+14+50239493 19342::9'QTY+198:0'LOC+14+5023949319342::9'QTY+83: 0'LOC+14+5023949319342::9'QTY+17:5'LOC+14+50239493 27619::9'QTY+198:0'LOC+14+5023949327619::9'QTY+83: 0'LOC+14+5023949327619::9'QTY+17:4'LOC+14+50239493 73414::9'QTY+198:1'LOC+14+5023949373414::9'QTY+83: 0'LOC+14+5023949373414::9'QTY+17:4'LOC+14+50239493 74976::9'QTY+198:0'LOC+14+5023949374976::9'QTY+83: 0'LOC+14+5023949374976::9'QTY+17:0'LOC+14+50239494 14768::9'QTY+198:5'LOC+14+5023949414768::9'QTY+83: 0'LOC+14+5023949414768::9'QTY+17:5'LOC+14+50239494 23933::9'QTY+198:0'LOC+14+5023949423933::9'QTY+83: 0'LOC+14+5023949423933::9'QTY+17:5'LOC+14+50239495 10183::9'QTY+198:0'LOC+14+5023949510183::9'QTY+83: 0'LOC+14+5023949510183::9'QTY+17:5'LOC+14+50239495 11753::9'QTY+198:0'LOC+14+5023949511753::9'QTY+83: 0'LOC+14+5023949511753::9'QTY+17:4'LOC+14+50239495 84122::9'QTY+198:0'LOC+14+5023949584122::9'QTY+83: 0'LOC+14+5023949584122::9'QTY+17:5'LOC+14+50239495 97339::9'QTY+198:1'LOC+14+5023949597339::9'QTY+83: 0'LOC+14+5023949597339::9'QTY+17:2'LOC+14+50239496 70870::9'QTY+198:3'LOC+14+5023949670870::9'QTY+83: 0'LOC+14+5023949670870::9'QTY+17:4'LOC+14+50239496 92755::9'QTY+198:1'LOC+14+5023949692755::9'QTY+83: 0'LOC+14+5023949692755::9'QTY+17:5'LOC+14+50239497 01028::9'QTY+198:0'LOC+14+5023949701028::9'QTY+83: 0'LOC+14+5023949701028::9'QTY+17:6'LOC+14+50239497 71634::9'QTY+198:0'LOC+14+5023949771634::9'QTY+83: 0'LOC+14+5023949771634::9'QTY+17:47'LOC+18+5023949 825700::9'QTY+17:5'LOC+14+5023949832131::9'QTY+198 :0'LOC+14+5023949832131::9'QTY+83:0'LOC+14+5023949 832131::9'QTY+17:5'LOC+14+5023949833970::9'QTY+198 :0'LOC+14+5023949833970::9'QTY+83:0'LOC+14+5023949 833970::9'QTY+17:5'LOC+14+5023949843304::9'QTY+198 :0'LOC+14+5023949843304::9'QTY+83:0'LOC+14+5023949 843304::9'QTY+17:5'LOC+14+5023949867056::9'QTY+198 :0'LOC+14+5023949867056::9'QTY+83:0'LOC+14+5023949 867056::9'QTY+17:5'LOC+14+5023949912859::9'QTY+198 :0'LOC+14+5023949912859::9'QTY+83:0'LOC+14+5023949 912859::9'QTY+17:5'LOC+14+5023949929392::9'QTY+198 :0'LOC+14+5023949929392::9'QTY+83:0'LOC+14+5023949 929392::9'QTY+17:3'LOC+14+5023949955601::9'QTY+198 :0'LOC+14+5023949955601::9'QTY+83:0'LOC+14+5023949 955601::9'QTY+17:6'LOC+14+5023949962472::9'QTY+198 :0'LOC+14+5023949962472::9'QTY+83:0'LOC+14+5023949 962472::9 Thanks Tom, you help is really appreciated. Brian Anyway, run this macro against your file and see what I mean: Sub testme3() Dim FName As String Dim FNum As Long Dim l As String Dim l1 As Variant Dim s As String Dim sChr As String Dim rng1 As Range, rng As Range Dim cell As Range, iloc As Long Columns("A:D").ClearContents Columns(3).NumberFormat = _ "0000000000000" FName = "C:\SLSRPT2.txt" FNum = FreeFile Open FName For Input As FNum Line Input #FNum, s s = Application.Clean(s) s = Replace(s, Chr(9), "") l = s l = Replace(l, "LIN+", "LIN+,") l = Replace(l, "LOC", "LIN+,,") l = Replace(l, ":EN'QTY+17:", ",") l = Replace(l, "::9'QTY+17:", ",17,") l = Replace(l, "::9'QTY+83:", ",83,") l = Replace(l, "::9'QTY+198:", ",198,") l = Replace(l, "'", "") ' l = Replace(l, "+", ",") l1 = Split(l, "LIN+") Cells(1, 1).Resize(UBound(l1) - _ LBound(l1) + 1).Value = Application. _ Transpose(l1) Close #FNum Rows(1).Delete Columns(1).Replace "++", "," Columns(1).TextToColumns _ Destination:=Range("A1"), _ 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)) Set rng2 = Range(Cells(1, 2), _ Cells(Rows.Count, 2).End(xlUp)) For Each cell In rng2.SpecialCells(xlConstants) cell.Offset(0, -1).Delete Shift:=xlShiftToLeft Next End Sub -- Regards, Tom Ogilvy "Brian" wrote in message ... Tom Ogilvy provided me with a fantastic snippet that imported in a similar file. I have tried to modify the previous script to handle the new text file layout however i have been recieving a runtime error 1004 amongst others when i have been playing with this. I have put this basically back to orig snippet provided, with a couple of mods. Please can you guys just have a look over the script see if you can see the glaring mistakes i have made whilst trying to modify Tom's script. I have included some sample text at the end of the post . --------------------------------------------------------- Sub GETINVRPT() Dim FName As String Dim FNum As Long Dim l As String Dim l1 As Variant Dim s As String Dim sChr As String Dim rng1 As Range, rng As Range Dim cell As Range, iloc As Long Columns("A:E").ClearContents Columns(5).NumberFormat = _ "0000000000000" FName = "C:\INVRPT.txt" FNum = FreeFile Open FName For Input As FNum Line Input #FNum, s s = Application.Clean(s) s = Replace(s, Chr(9), "") l = s l = Replace(l, "LIN+", "LIN+,") l = Replace(l, "LOC", "LIN+LOC") l = Replace(l, ":EN'QTY+17:", ",") l = Replace(l, "::9'QTY+17:", ",") l = Replace(l, "::9'QTY+198:", ",") l = Replace(l, "::9'QTY+83:", ",") l = Replace(l, "'", "") ' l = Replace(l, "+", ",") l1 = Split(l, "LIN+") Cells(1, 1).Resize(UBound(l1) - _ LBound(l1) + 1).Value = Application. _ Transpose(l1) Close #FNum Rows(1).Delete Columns(1).Replace "++", "," Columns(1).TextToColumns _ Destination:=Range("A1"), _ 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)) Set rng1 = Cells(Rows.Count, 5).End(xlUp) iloc = InStr(1, rng1, "UN", vbTextCompare) rng1 = Left(rng1, iloc - 1) Set rng = Columns(1).SpecialCells(xlConstants) For Each cell In rng iloc = InStr(1, cell, "+", vbTextCompare) iloc = InStr(iloc + 1, cell, "+", vbTextCompare) cell.Value = "'" & Mid(cell, iloc + 1, 13) Next Set rng = Columns(1).SpecialCells(xlBlanks) rng.Formula = "=" & rng(1).Offset(-1, 0).Address(0, 0) Set rng = Range(Cells(1, 1), _ Cells(Rows.Count, 1).End(xlUp)) rng.Formula = rng.Value Set rng = Columns(2).SpecialCells(xlBlanks) rng.EntireRow.Delete Columns(2).Delete Rows(1).Insert Range("A1:E1").Value = _ Array("LOC", "EAN", "QTY17", "QTY198", "QTY83") Columns("A:E").AutoFit Range("A1").CurrentRegion.Name = "Database" End Sub ---------------------------------------------------------------------- |
Import long string (modified Tom O snippet help!)
Tom,
Looking at LIN+1 'LIN+1++21298776:EN'QTY+17:1'LOC+14+5023949771634: :9'QTY+198:0'LOC+14+5023949771634::9'QTY+83:0'LOC+ 14+5023949771634::9 The first Qty+17 assigned to the LOC which comes immediately after.... bloody stupid format for a file! So when i imported the file with the line commented out i was left with a entry at the end with no value... "Tom Ogilvy" wrote in message ... This does the first part of the processing. However, it isn't as clean as the other file. The lines that end up with a form like: +14+5023949771634::9 and originate as 'LOC+14+5023949771634::9' It is not clear what to do with them. they appear at the end of the LIN group and would normally be QTY+17 if they followed the pattern. The 17 type lines that have the format EN'QTY+17:3 are found at the end of the LIN lines. So, not clear what to do with the Number after the ":" (3 in the above example). Anyway, run this macro against your file and see what I mean: Sub testme3() Dim FName As String Dim FNum As Long Dim l As String Dim l1 As Variant Dim s As String Dim sChr As String Dim rng1 As Range, rng As Range Dim cell As Range, iloc As Long Columns("A:D").ClearContents Columns(3).NumberFormat = _ "0000000000000" FName = "C:\SLSRPT2.txt" FNum = FreeFile Open FName For Input As FNum Line Input #FNum, s s = Application.Clean(s) s = Replace(s, Chr(9), "") l = s l = Replace(l, "LIN+", "LIN+,") l = Replace(l, "LOC", "LIN+,,") l = Replace(l, ":EN'QTY+17:", ",") l = Replace(l, "::9'QTY+17:", ",17,") l = Replace(l, "::9'QTY+83:", ",83,") l = Replace(l, "::9'QTY+198:", ",198,") l = Replace(l, "'", "") ' l = Replace(l, "+", ",") l1 = Split(l, "LIN+") Cells(1, 1).Resize(UBound(l1) - _ LBound(l1) + 1).Value = Application. _ Transpose(l1) Close #FNum Rows(1).Delete Columns(1).Replace "++", "," Columns(1).TextToColumns _ Destination:=Range("A1"), _ 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)) Set rng2 = Range(Cells(1, 2), _ Cells(Rows.Count, 2).End(xlUp)) For Each cell In rng2.SpecialCells(xlConstants) cell.Offset(0, -1).Delete Shift:=xlShiftToLeft Next End Sub -- Regards, Tom Ogilvy "Brian" wrote in message ... Tom Ogilvy provided me with a fantastic snippet that imported in a similar file. I have tried to modify the previous script to handle the new text file layout however i have been recieving a runtime error 1004 amongst others when i have been playing with this. I have put this basically back to orig snippet provided, with a couple of mods. Please can you guys just have a look over the script see if you can see the glaring mistakes i have made whilst trying to modify Tom's script. I have included some sample text at the end of the post . --------------------------------------------------------- Sub GETINVRPT() Dim FName As String Dim FNum As Long Dim l As String Dim l1 As Variant Dim s As String Dim sChr As String Dim rng1 As Range, rng As Range Dim cell As Range, iloc As Long Columns("A:E").ClearContents Columns(5).NumberFormat = _ "0000000000000" FName = "C:\INVRPT.txt" FNum = FreeFile Open FName For Input As FNum Line Input #FNum, s s = Application.Clean(s) s = Replace(s, Chr(9), "") l = s l = Replace(l, "LIN+", "LIN+,") l = Replace(l, "LOC", "LIN+LOC") l = Replace(l, ":EN'QTY+17:", ",") l = Replace(l, "::9'QTY+17:", ",") l = Replace(l, "::9'QTY+198:", ",") l = Replace(l, "::9'QTY+83:", ",") l = Replace(l, "'", "") ' l = Replace(l, "+", ",") l1 = Split(l, "LIN+") Cells(1, 1).Resize(UBound(l1) - _ LBound(l1) + 1).Value = Application. _ Transpose(l1) Close #FNum Rows(1).Delete Columns(1).Replace "++", "," Columns(1).TextToColumns _ Destination:=Range("A1"), _ 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)) Set rng1 = Cells(Rows.Count, 5).End(xlUp) iloc = InStr(1, rng1, "UN", vbTextCompare) rng1 = Left(rng1, iloc - 1) Set rng = Columns(1).SpecialCells(xlConstants) For Each cell In rng iloc = InStr(1, cell, "+", vbTextCompare) iloc = InStr(iloc + 1, cell, "+", vbTextCompare) cell.Value = "'" & Mid(cell, iloc + 1, 13) Next Set rng = Columns(1).SpecialCells(xlBlanks) rng.Formula = "=" & rng(1).Offset(-1, 0).Address(0, 0) Set rng = Range(Cells(1, 1), _ Cells(Rows.Count, 1).End(xlUp)) rng.Formula = rng.Value Set rng = Columns(2).SpecialCells(xlBlanks) rng.EntireRow.Delete Columns(2).Delete Rows(1).Insert Range("A1:E1").Value = _ Array("LOC", "EAN", "QTY17", "QTY198", "QTY83") Columns("A:E").AutoFit Range("A1").CurrentRegion.Name = "Database" End Sub ---------------------------------------------------------------------- Results i am after: LOC | EAN | QTY17 | QTY198 | QTY83 0000000000000 | 0000000000000 | 0 | 0 | 0 from a table in the above format i have already created a pivot with lookups to make a very readable report, Any help really appreciated. Brian -------------------------------------------------------------------------- - Sample Text. Note: I cut ou a massive chunk in the middle but kept the format... UNB+UNOA:3+5023949000004:14+5014838000001+060205:0 513+436+ETRADING+INVRPT'UN H+23+INVRPT:D:96A:UN:EAN008'BGM+35+00000009+9'DTM+ 366:20060204:102'NAD+BY+50 23949000004::9'NAD+SU+5014838000001::9'LIN+1++2129 8776:EN'QTY+17:1'LOC+14+50 23949771634::9'QTY+198:0'LOC +14+5023949771634::9'QTY+83:0'LOC+14+5023949771634 ::9'LIN+2++21326806:EN'QTY +17:3'LOC+14+5023949057895::9'QTY+198:0'LOC+14+502 3949057895::9'QTY+83:0'LOC +14+5023949057895::9'QTY+17:4'LOC+14+5023949136774 ::9'QTY+198:0'LOC+14+50239 49136774::9'QTY+83:0'LOC+14+ 5023949136774::9'QTY+17:2'LOC+14+5023949182579::9' QTY+198:0'LOC+14+502394918 2579::9'QTY+83:0'LOC+14+5023949182579::9'QTY+17:5' LOC+14+5023949223920::9'QT Y+198:0'LOC+14+5023949223920::9'QTY+83:0'LOC+14+50 23949223920::9'QTY+17:4'LO C+14+5023949248730::9'QTY+19 8:0'LOC+14+5023949248730::9'QTY+83:0'LOC+14+502394 9248730::9'QTY+17:3'LOC+14 +5023949294535::9'QTY+198:0'LOC+14+5023949294535:: 9'QTY+83:0'LOC+14+50239492 94535::9'QTY+17:3'LOC+14+5023949319342::9'QTY+198: 0'LOC+14+5023949319342::9' QTY+83:0'LOC+14+502394931934 2::9'QTY+17:4'LOC+14+5023949373414::9'QTY+198:0'LO C+14+5023949373414::9'QTY+ 83:0'LOC+14+5023949373414::9'QTY+17:3'LOC+14+50239 49374976::9'QTY+198:0'LOC+ 14+5023949374976::9'QTY+83:0'LOC+14+5023949374976: :9'QTY+17:1'LOC+14+5023949 414768::9'QTY+198:0'LOC+14+5 023949414768::9'QTY+83:0'LOC+14+5023949414768::9'Q TY+17:3'LOC+14+50239494239 33::9'QTY+198:0'LOC+14+5023949423933::9'QTY+83:0'L OC+14+5023949423933::9'QTY +17:3'LOC+14+5023949584122::9'QTY+198:0'LOC+14+502 3949584122::9'QTY+83:0'LOC +14+5023949584122::9'QTY+17: 3'LOC+14+5023949670870::9'QTY+198:0'LOC+14+5023949 670870::9'QTY+83:0'LOC+14+ 5023949670870::9'QTY+17:3'LOC+14+5023949692755::9' QTY+198:0'LOC+14+502394969 2755::9'QTY+83:0'LOC+14+5023949692755::9'QTY+17:8' LOC+14+5023949771634::9'QT Y+198:0'LOC+14+5023949771634 ::9'QTY+83:0'LOC+14+5023949771634::9'QTY+17:7'LOC+ 18+5023949825700::9'QTY+17 :4'LOC+14+5023949867056::9'QTY+198:0'LOC+14+502394 9867056::9'QTY+83:0'LOC+14 +5023949867056::9'QTY+17:5'LOC+14+5023949929392::9 'QTY+198:0'LOC+14+50239499 29392::9'QTY+83:0'LOC+14+502 3949929392::9'LIN+3++21348914:EN'QTY+17:1'LOC+14+5 023949248730::9'QTY+198:0' LOC+14+5023949248730::9'QTY+83:0'LOC+14+5023949248 730::9'QTY+17:2'LOC+14+502 3949319342::9'QTY+198:0'LOC+14+5023949319342::9'QT Y+83:0'LOC+14+502394931934 2::9'LIN+4++21381416:EN'QTY+ 17:1'LOC+14+5023949182579::9'QTY+198:0'LOC+14+5023 949182579::9'QTY+83:0'LOC+ 14+5023949182579::9'LIN+5++21481499:EN'QTY+17:1'LO C+14+5023949057895::9'QTY+ 198:0'LOC+14+5023949057895::9'QTY+83:0'LOC+14+5023 949057895::9'QTY+17:1'LOC+ 14+5023949373414::9'QTY+198: 0'LOC+14+5023949373414::9'QTY+83:0'LOC+14+50239493 73414::9'LIN+6++21481505:E N'QTY+17:1'LOC+14+5023949057895::9'QTY+198:0'LOC+1 4+5023949057895::9'QTY+83: 0'LOC+14+5023949057895::9'QTY+17:2'LOC+14+50239497 71634::9'QTY+198:0'LOC+14+ 5023949771634::9'QTY+83:0'LO C+14+5023949771634::9'LIN+7++21481512:EN'QTY+17:1' LOC+14+5023949057895::9'QT Y+198:0'LOC+14+5023949057895::9'QTY+83:0'LOC+14+50 23949057895::9'QTY+17:3'LO C+14+5023949145040::9'QTY+198:0'LOC+14+50239491450 40::9'QTY+83:0'LOC+14+5023 949145040::9'QTY+17:1'LOC+14 +5023949670870::9'QTY+198:0'LOC+14+5023949670870:: 9'QTY+83:0'LOC+14+50239496 70870::9'QTY+17:1'LOC+14+5023949701028::9'QTY+198: 0'LOC+14+5023949701028::9' QTY+83:0'LOC+14+5023949701028::9'QTY+17:1'LOC+14+5 023949771634::9'QTY+198:0' LOC+14+5023949771634::9'QTY+ 83:0'LOC+14+5023949771634::9'QTY+17:1'LOC+14+50239 49832131::9'QTY+198:0'LOC+ 14+5023949832131::9'QTY+83:0'LOC+14+5023949832131: :9'LIN+8++21481529:EN'QTY+ 17:2'LOC+14+5023949223920::9'QTY+198:0'LOC+14+5023 949223920::9'QTY+83:0'LOC+ 14+5023949223920::9'QTY+17:1 'LOC+14+5023949374976::9'QTY+198:0'LOC+14+50239493 74976::9'QTY+83:0'LOC+14+5 023949374976::9'QTY+17:1'LOC+14+5023949832131::9'Q TY+198:0'LOC+14+5023949832 131::9'QTY+83:0'LOC+14+5023949832131::9'LIN+9++214 93393:EN'QTY+17:1'LOC+14+5 023949049625::9'QTY+198:0'LO C+14+5023949049625::9'QTY+83:0'LOC+14+502394904962 5::9'LIN+10++5014838064023 :EN'QTY+17:5'LOC+14+5023949049625::9'QTY+198:0'LOC +14+5023949049625::9'QTY+8 3:0'LOC+14+5023949049625::9'QTY+17:5'LOC+14+502394 9057895::9'QTY+198:0'LOC+1 4+5023949057895::9'QTY+83:0' LOC+14+5023949057895::9'QTY+17:5'LOC+14+5023949136 774::9'QTY+198:0'LOC+14+50 23949136774::9'QTY+83:0'LOC+14+5023949136774::9'QT Y+17:2'LOC+14+502394914504 0::9'QTY+198:1'LOC+14+5023949145040::9'QTY+83:0'LO C+14+5023949145040::9'QTY+ 17:11'LOC+14+5023949182579:: 9'QTY+198:0'LOC+14+5023949182579::9'QTY+83:0'LOC+1 4+5023949182579::9'QTY+17: 2'LOC+14+5023949223920::9'QTY+198:0'LOC+14+5023949 223920::9'QTY+83:0'LOC+14+ 5023949223920::9'QTY+17:5'LOC+14+5023949232199::9' QTY+198:0'LOC+14+502394923 2199::9'QTY+83:0'LOC+14+5023 949232199::9'QTY+17:5'LOC+14+5023949248730::9'QTY+ 198:0'LOC+14+5023949248730 ::9'QTY+83:0'LOC+14+5023949248730::9'QTY+17:11'LOC +14+5023949294535::9'QTY+1 98:2'LOC+14+5023949294535::9'QTY+83:0'LOC+14+50239 49294535::9'QTY+17:5'LOC+1 4+5023949319342::9'QTY+198:0 'LOC+14+5023949319342::9'QTY+83:0'LOC+14+502394931 9342::9'QTY+17:4'LOC+14+50 23949327619::9'QTY+198:0'LOC+14+5023949327619::9'Q TY+83:0'LOC+14+50239493276 19::9'QTY+17:5'LOC+14+5023949373414::9'QTY+198:0'L OC+14+5023949373414::9'QTY +83:0'LOC+14+5023949373414:: 9'QTY+17:5'LOC+14+5023949374976::9'QTY+198:0'LOC+1 4+5023949374976::9'QTY+83: 0'LOC+14+5023949374976::9'QTY+17:3'LOC+14+50239494 14768::9'QTY+198:0'LOC+14+ 5023949414768::9'QTY+83:0'LOC+14+5023949414768::9' QTY+17:5'LOC+14+5023949423 933::9'QTY+198:0'LOC+14+5023 949423933::9'QTY+83:0'LOC+14+5023949423933::9'QTY+ 17:4'LOC+14+5023949510183: :9'QTY+198:0'LOC+14+5023949510183::9'QTY+83:0'LOC+ 14+5023949510183::9'QTY+17 :5'LOC+14+5023949511753::9'QTY+198:0'LOC+14+502394 9511753::9'QTY+83:0'LOC+14 +5023949511753::9'QTY+17:3'L OC+14+5023949584122::9'QTY+198:0'LOC+14+5023949584 122::9'QTY+83:0'LOC+14+502 3949584122::9'QTY+17:5'LOC+14+5023949597339::9'QTY +198:0'LOC+14+502394959733 9::9'QTY+83:0'LOC+14+5023949597339::9'QTY+17:5'LOC +14+5023949670870::9'QTY+1 98:0'LOC+14+5023949670870::9 'QTY+83:0'LOC+14+5023949670870::9'QTY+17:5'LOC+14+ 5023949692755::9'QTY+198:0 'LOC+14+5023949692755::9'QTY+83:0'LOC+14+502394969 2755::9'QTY+17:5'LOC+14+50 23949701028::9'QTY+198:0'LOC+14+5023949701028::9'Q TY+83:0'LOC+14+50239497010 28::9'QTY+17:6'LOC+14+502394 9771634::9'QTY+198:0'LOC+14+5023949771634::9'QTY+8 3:0'LOC+14+5023949771634:: 9'QTY+17:5'LOC+14+5023949832131::9'QTY+198:0'LOC+1 4+5023949832131::9'QTY+83: 0'LOC+14+5023949832131::9'QTY+17:5'LOC+14+50239498 33970::9'QTY+198:0'LOC+14+ 5023949833970::9'QTY+83:0'LO C+14+5023949833970::9'QTY+17:6'LOC+14+502394984330 4::9'QTY+198:0'LOC+14+5023 949843304::9'QTY+83:0'LOC+14+5023949843304::9'QTY+ 17:1'LOC+14+5023949867056: :9'QTY+198:2'LOC+14+5023949867056::9'QTY+83:0'LOC+ 14+5023949867056::9'QTY+17 :5'LOC+14+5023949912859::9'Q TY+198:0'LOC+14+5023949912859::9'QTY+83:0'LOC+14+5 023949912859::9'QTY+17:4'L OC+14+5023949929392::9'QTY+198:0'LOC+14+5023949929 392::9'QTY+83:0'LOC+14+502 3949929392::9'QTY+17:5'LOC+14+5023949955601::9'QTY +198:0'LOC+14+502394995560 1::9'QTY+83:0'LOC+14+5023949 955601::9'QTY+17:5'LOC+14+5023949962472::9'QTY+198 :1'LOC+14+5023949962472::9 'QTY+83:0'LOC+14+5023949962472::9'LIN+11++50148380 66317:EN'QTY+17:2'LOC+14+5 023949057895::9'QTY+198:0'LOC+14+5023949057895::9' QTY+83:0'LOC+14+5023949057 895::9'QTY+17:1'LOC+14+50239 49136774::9'QTY+198:0'LOC+14+5023949136774::9'QTY+ 83:0'LOC+14+5023949136774: :9'QTY+17:1'LOC+14+5023949182579::9'QTY+198:0'LOC+ 14+5023949182579::9'QTY+83 :0'LOC+14+5023949182579::9'QTY+17:1'LOC+14+5023949 223920::9'QTY+198:0'LOC+14 +5023949223920::9'QTY+83:0'L OC+14+5023949223920::9'QTY+17:3'LOC+14+50239492487 30::9'QTY+198:0'LOC+14+502 3949248730::9'QTY+83:0'LOC+14+5023949248730::9'QTY +17:3'LOC+14+5023949373414 ::9'QTY+198:0'LOC+14+5023949373414::9'QTY+83:0'LOC +14+5023949373414::9'QTY+1 7:1'LOC+14+5023949374976::9' QTY+198:0'LOC+14+5023949374976::9'QTY+83:0'LOC+14+ 5023949374976::9'QTY+17:1' LOC+14+5023949423933::9'QTY+198:0'LOC+14+502394942 3933::9'QTY+83:0'LOC+14+50 23949423933::9'QTY+17:3'LOC+14+5023949511753::9'QT Y+198:0'LOC+14+50239495117 53::9'QTY+83:0'LOC+14+502394 9511753::9'QTY+17:2'LOC+14+5023949584122::9'QTY+19 8:0'LOC+14+5023949584122:: 9'QTY+83:0'LOC+14+5023949584122::9'QTY+17:1'LOC+14 +5023949597339::9'QTY+198: 0'LOC+14+5023949597339::9'QTY+83:0'LOC+14+50239495 97339::9'QTY+17:4'LOC+14+5 023949764661::9'QTY+198:0'LO C+14+5023949764661::9'QTY+83:0'LOC+14+502394976466 1::9'QTY+17:3'LOC+14+50239 49771634::9'QTY+198:0'LOC+14+5023949771634::9'QTY+ 83:0'LOC+14+5023949771634: :9'QTY+17:1'LOC+14+5023949833970::9'QTY+198:0'LOC+ 14+5023949833970::9'QTY+83 :0'LOC+14+5023949833970::9'Q TY+17:1'LOC+14+5023949867056::9'QTY+198:0'LOC+14+5 023949867056::9'QTY+83:0'L OC+14+5023949867056::9'QTY+17:1'LOC+14+50239499293 92::9'QTY+198:0'LOC+14+502 3949929392::9'QTY+83:0'LOC+14+5023949929392::9'QTY +17:1'LOC+14+5023949962472 ::9'QTY+198:0'LOC+14+5023949 962472::9'QTY+83:0'LOC+14+5023949962472::9'LIN+129 ++5014838370384:EN'QTY+17: 1'LOC+14+5023949182579::9'QTY+198:0'LOC+14+5023949 182579::9'QTY+83:0'LOC+14+ 5023949182579::9'QTY+17:2'LOC+14+5023949670870::9' QTY+198:0'LOC+14+502394967 0870::9'QTY+83:1'LOC+14+5023949670870::9'QTY+17:2' LOC+1 4+5023949867056::9'QTY+198:0'LOC+14+5023949867056: :9'QTY+83:0'LOC+14+5023949 867056::9'LIN+130++5014838370414:EN'QTY+17:2'LOC+1 4+5023949145040::9'QTY+198 :0'LOC+14+5023949145040::9'QTY+83:0'LOC+14+5023949 145040::9'QTY+17:1'LOC+14+ 5023949327619::9'QTY+198:0'L OC+14+5023949327619::9'QTY+83:0'LOC+14+50239493276 19::9'QTY+17:1'LOC+14+5023 949584122::9'QTY+198:0'LOC+14+5023949584122::9'QTY +83:0'LOC+14+5023949584122 ::9'QTY+17:2'LOC+14+5023949670870::9'QTY+198:0'LOC +14+5023949670870::9'QTY+8 3:0'LOC+14+5023949670870::9' QTY+17:1'LOC+14+5023949929392::9'QTY+198:0'LOC+14+ 5023949929392::9'QTY+83:0' LOC+14+5023949929392::9'LIN+131++5014838370438:EN' QTY+17:0'LOC+14+5023949319 342::9'QTY+198:0'LOC+14+5023949319342::9'QTY+83:2' LOC+14+5023949319342::9'UN T+15237+23'UNZ+1+436' |
Import long string (modified Tom O snippet help!)
Sub testme3()
Dim FName As String Dim FNum As Long Dim l As String Dim l1 As Variant Dim s As String Dim sChr As String Dim rng1 As Range, rng As Range Dim cell As Range, iloc As Long Columns("A:M").ClearContents Columns(3).NumberFormat = _ "0000000000000" FName = "C:\SLSRPT2.txt" FNum = FreeFile Open FName For Input As FNum Line Input #FNum, s s = Replace(s, Chr(9), "") l = s l = Replace(l, "LIN+", "LIN+,") l = Replace(l, "LOC", "LIN+,,") l = Replace(l, ":EN'QTY+17:", ",") l = Replace(l, "::9'QTY+17:", ",17,") l = Replace(l, "::9'QTY+83:", ",83,") l = Replace(l, "::9'QTY+198:", ",198,") l = Replace(l, "'", "") ' l = Replace(l, "+", ",") l1 = Split(l, "LIN+") Cells(1, 1).Resize(UBound(l1) - _ LBound(l1) + 1).Value = Application. _ Transpose(l1) Close #FNum Rows(1).Delete Columns(1).Replace "++", "," Columns(1).TextToColumns _ Destination:=Range("A1"), _ 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)) Set rng2 = Range(Cells(1, 2), _ Cells(Rows.Count, 2).End(xlUp)) For Each cell In rng2.SpecialCells(xlConstants) cell.Offset(0, -1).Delete Shift:=xlShiftToLeft Next Set cell = Cells(Rows.Count, "C").End(xlUp) lastrow = cell.Row If InStr(1, cell, "UNT", vbTextCompare) 0 Then cell = Left(cell, InStr(1, cell, "UNT", vbTextCompare) - 1) End If For i = 1 To cell.Row Set cell1 = Cells(i, "C") If Len(Trim(cell1)) 5 Then iloc = InStr(1, cell1, "+", vbTextCompare) Do While iloc 0 cell1.Value = Mid(cell1, iloc + 1, 255) iloc = InStr(1, cell1, "+", vbTextCompare) Loop If Right(cell1, 3) = "::9" Then cell1.Value = Replace(cell1, "::9", "") End If Else cell1.ClearContents End If Next Set rng = Nothing OldEan = "" For i = 2 To lastrow If Cells(i, 3) < "" Then If Cells(i, 3) < OldEan Then OldEan = Cells(i, 3) firstrow = i Else If rng Is Nothing Then Set rng = Cells(i, 3) Else Set rng = Union(rng, Cells(i, 3)) End If End If If CLng(Cells(i, "D")) = 17 Then col = 8 ElseIf CLng(Cells(i, "D")) = 198 Then col = 6 ElseIf CLng(Cells(i, "D")) = 83 Then col = 7 End If If Trim(Cells(i, "E")) < "" Then Cells(firstrow, col) = Cells(i, "E") Else If rng Is Nothing Then Set rng = Cells(i, "C") Else Set rng = Union(rng, Cells(i, "C")) End If End If End If Next rng.EntireRow.Delete Set rng = Columns(2).SpecialCells(xlBlanks) rng.Formula = "=" & rng(1).Offset(-1, 0).Address(0, 0) Set rng = Range(Cells(1, 2), _ Cells(Rows.Count, 2).End(xlUp)) rng.Formula = rng.Value Set rng = Columns(3).SpecialCells(xlBlanks) rng.EntireRow.Delete Columns("D:E").Delete Columns("A:A").Delete Range("A1:E1").Value = Array( _ "EAN", "LOC", "QTY198", "QTY83", "QTY17") End Sub -- Regards, Tom Ogilvy |
Import long string (modified Tom O snippet help!)
Hi Tom,
been looking at the results and found the following 'LIN+1++21298776:EN'QTY+17:1'LOC+14+5023949771634: :9'QTY+198:0'LOC+14+5023949771634::9'QTY+83:0'LOC+ 14+5023949771634::9 If you look at the line above it appears that the QTY+17 immediately after the :EN is related to the next LOC... So they appear to have a text format like : LIN - EAN - QTY17 - LOC - QTY198 - LOC - QTY83 - LOC They appear to be giving the values in the QTY followed by the LOC, When i ran the code it was out on the QTY17 by one place each time. This became very apparant when LOC+14 (Store) and LOC+18 (Warehouse) was displayed. Also noticed that the LOC column still included the prefix (which i would prefer to strip and just leave the 13 digit code) =14+ (store identifier) =18+ (Warehouse identifier) Looking at the code i assume that the line l = Replace(l, ":EN'QTY+17:", ",") and the would have to be modified. Also it makes it more complicated when multiple locations have a product as then i also have l = Replace(l, "::9'QTY+17:", ",17,") to contend with. Does this make sense ? I can see what i mean, just not sure i explained it very well... Brian "Tom Ogilvy" wrote in message ... Sub testme3() Dim FName As String Dim FNum As Long Dim l As String Dim l1 As Variant Dim s As String Dim sChr As String Dim rng1 As Range, rng As Range Dim cell As Range, iloc As Long Columns("A:M").ClearContents Columns(3).NumberFormat = _ "0000000000000" FName = "C:\SLSRPT2.txt" FNum = FreeFile Open FName For Input As FNum Line Input #FNum, s s = Replace(s, Chr(9), "") l = s l = Replace(l, "LIN+", "LIN+,") l = Replace(l, "LOC", "LIN+,,") l = Replace(l, ":EN'QTY+17:", ",") l = Replace(l, "::9'QTY+17:", ",17,") l = Replace(l, "::9'QTY+83:", ",83,") l = Replace(l, "::9'QTY+198:", ",198,") l = Replace(l, "'", "") ' l = Replace(l, "+", ",") l1 = Split(l, "LIN+") Cells(1, 1).Resize(UBound(l1) - _ LBound(l1) + 1).Value = Application. _ Transpose(l1) Close #FNum Rows(1).Delete Columns(1).Replace "++", "," Columns(1).TextToColumns _ Destination:=Range("A1"), _ 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)) Set rng2 = Range(Cells(1, 2), _ Cells(Rows.Count, 2).End(xlUp)) For Each cell In rng2.SpecialCells(xlConstants) cell.Offset(0, -1).Delete Shift:=xlShiftToLeft Next Set cell = Cells(Rows.Count, "C").End(xlUp) lastrow = cell.Row If InStr(1, cell, "UNT", vbTextCompare) 0 Then cell = Left(cell, InStr(1, cell, "UNT", vbTextCompare) - 1) End If For i = 1 To cell.Row Set cell1 = Cells(i, "C") If Len(Trim(cell1)) 5 Then iloc = InStr(1, cell1, "+", vbTextCompare) Do While iloc 0 cell1.Value = Mid(cell1, iloc + 1, 255) iloc = InStr(1, cell1, "+", vbTextCompare) Loop If Right(cell1, 3) = "::9" Then cell1.Value = Replace(cell1, "::9", "") End If Else cell1.ClearContents End If Next Set rng = Nothing OldEan = "" For i = 2 To lastrow If Cells(i, 3) < "" Then If Cells(i, 3) < OldEan Then OldEan = Cells(i, 3) firstrow = i Else If rng Is Nothing Then Set rng = Cells(i, 3) Else Set rng = Union(rng, Cells(i, 3)) End If End If If CLng(Cells(i, "D")) = 17 Then col = 8 ElseIf CLng(Cells(i, "D")) = 198 Then col = 6 ElseIf CLng(Cells(i, "D")) = 83 Then col = 7 End If If Trim(Cells(i, "E")) < "" Then Cells(firstrow, col) = Cells(i, "E") Else If rng Is Nothing Then Set rng = Cells(i, "C") Else Set rng = Union(rng, Cells(i, "C")) End If End If End If Next rng.EntireRow.Delete Set rng = Columns(2).SpecialCells(xlBlanks) rng.Formula = "=" & rng(1).Offset(-1, 0).Address(0, 0) Set rng = Range(Cells(1, 2), _ Cells(Rows.Count, 2).End(xlUp)) rng.Formula = rng.Value Set rng = Columns(3).SpecialCells(xlBlanks) rng.EntireRow.Delete Columns("D:E").Delete Columns("A:A").Delete Range("A1:E1").Value = Array( _ "EAN", "LOC", "QTY198", "QTY83", "QTY17") End Sub -- Regards, Tom Ogilvy |
Import long string (modified Tom O snippet help!)
This is a sample of LIN+65
Current import produces (to the right is the info that is correct): I have manual giggled the data for now, but would have to manually add the first missing QTY17, also like i said the prefix in the LOC column also adds =14+ and =18+ making the LOC code incorrect. EAN LOC QTY198 QTY83 QTY17 EAN LOC QTY198 QTY83 QTY17 5014838156384 5023949049639 0 0 6 5014838156384 5023949049625 0 0 3 5014838156384 5023949057909 0 0 11 5014838156384 5023949057895 0 0 6 5014838156384 5023949136788 0 0 9 5014838156384 5023949136774 0 0 11 5014838156384 5023949145054 0 0 15 5014838156384 5023949145040 0 0 9 5014838156384 5023949182593 0 0 8 5014838156384 5023949182579 0 0 15 5014838156384 5023949223934 2 0 3 5014838156384 5023949223920 2 0 8 5014838156384 5023949232213 1 0 9 5014838156384 5023949232199 1 0 3 5014838156384 5023949248744 0 0 9 5014838156384 5023949248730 0 0 9 5014838156384 5023949294549 2 0 11 5014838156384 5023949294535 2 0 9 5014838156384 5023949319356 0 0 11 5014838156384 5023949319342 0 0 11 5014838156384 5023949327633 0 0 6 5014838156384 5023949327619 0 0 11 5014838156384 5023949373428 3 0 10 5014838156384 5023949373414 3 0 6 5014838156384 5023949374990 0 0 4 5014838156384 5023949374976 0 0 10 5014838156384 5023949414782 0 0 7 5014838156384 5023949414768 0 0 4 5014838156384 5023949423947 0 0 9 5014838156384 5023949423933 0 0 7 5014838156384 5023949510197 0 0 5 5014838156384 5023949510183 0 0 9 5014838156384 5023949511767 0 0 16 5014838156384 5023949511753 0 0 5 5014838156384 5023949584136 0 0 6 5014838156384 5023949584122 0 0 16 5014838156384 5023949597353 0 0 12 5014838156384 5023949597339 0 0 6 5014838156384 5023949670884 1 0 7 5014838156384 5023949670870 1 0 12 5014838156384 5023949692769 0 0 5 5014838156384 5023949692755 0 0 7 5014838156384 5023949701042 0 0 15 5014838156384 5023949701028 0 0 5 5014838156384 5023949764675 0 0 5 5014838156384 5023949764661 0 0 15 5014838156384 5023949771648 0 0 87 5014838156384 5023949771634 0 0 5 5014838156384 5023949825718 3 5014838156384 5023949825700 87 5014838156384 5023949832145 0 0 4 5014838156384 5023949832131 0 0 3 5014838156384 5023949833984 0 0 3 5014838156384 5023949833970 0 0 4 5014838156384 5023949843318 0 0 11 5014838156384 5023949843304 0 0 3 5014838156384 5023949867070 0 0 4 5014838156384 5023949867056 0 0 11 5014838156384 5023949912873 0 0 4 5014838156384 5023949912859 0 0 4 5014838156384 5023949929406 0 0 1 5014838156384 5023949929392 0 0 4 5014838156384 5023949955615 0 0 6 5014838156384 5023949955601 0 0 1 5014838156384 5023949962486 0 0 5014838156384 5023949962472 0 0 6 'LIN+65++5014838156384:EN'QTY+17:3'LOC+14+50239490 49625::9'QTY+198:0'LOC+14+5023949049625::9'QTY+83: 0'LOC+14+5023949049625::9'QTY+17:6'LOC+14+50239490 57895::9'QTY+198:0'LOC+14+5023949057895::9'QTY+83: 0'LOC+14+5023949057895::9'QTY+17:11'LOC+14+5023949 136774::9'QTY+198:0'LOC+14+5023949136774::9'QTY+83 :0'LOC+14+5023949136774::9'QTY+17:9'LOC+14+5023949 145040::9'QTY+198:0'LOC+14+5023949145040::9'QTY+83 :0'LOC+14+5023949145040::9'QTY+17:15'LOC+14+502394 9182579::9'QTY+198:0'LOC+14+5023949182579::9'QTY+8 3:0'LOC+14+5023949182579::9'QTY+17:8'LOC+14+502394 9223920::9'QTY+198:2'LOC+14+5023949223920::9'QTY+8 3:0'LOC+14+5023949223920::9'QTY+17:3'LOC+14+502394 9232199::9'QTY+198:1'LOC+14+5023949232199::9'QTY+8 3:0'LOC+14+5023949232199::9'QTY+17:9'LOC+14+502394 9248730::9'QTY+198:0'LOC+14+5023949248730::9'QTY+8 3:0'LOC+14+5023949248730::9'QTY+17:9'LOC+14+502394 9294535::9'QTY+198:2'LOC+14+5023949294535::9'QTY+8 3:0'LOC+14+5023949294535::9'QTY+17:11'LOC+14+50239 49319342::9'QTY+198:0'LOC+14+5023949319342::9'QTY+ 83:0'LOC+14+5023949319342::9'QTY+17:11'LOC+14+5023 949327619::9'QTY+198:0'LOC+14+5023949327619::9'QTY +83:0'LOC+14+5023949327619::9'QTY+17:6'LOC+14+5023 949373414::9'QTY+198:3'LOC+14+5023949373414::9'QTY +83:0'LOC+14+5023949373414::9'QTY+17:10'LOC+14+502 3949374976::9'QTY+198:0'LOC+14+5023949374976::9'QT Y+83:0'LOC+14+5023949374976::9'QTY+17:4'LOC+14+502 3949414768::9'QTY+198:0'LOC+14+5023949414768::9'QT Y+83:0'LOC+14+5023949414768::9'QTY+17:7'LOC+14+502 3949423933::9'QTY+198:0'LOC+14+5023949423933::9'QT Y+83:0'LOC+14+5023949423933::9'QTY+17:9'LOC+14+502 3949510183::9'QTY+198:0'LOC+14+5023949510183::9'QT Y+83:0'LOC+14+5023949510183::9'QTY+17:5'LOC+14+502 3949511753::9'QTY+198:0'LOC+14+5023949511753::9'QT Y+83:0'LOC+14+5023949511753::9'QTY+17:16'LOC+14+50 23949584122::9'QTY+198:0'LOC+14+5023949584122::9'Q TY+83:0'LOC+14+5023949584122::9'QTY+17:6'LOC+14+50 23949597339::9'QTY+198:0'LOC+14+5023949597339::9'Q TY+83:0'LOC+14+5023949597339::9'QTY+17:12'LOC+14+5 023949670870::9'QTY+198:1'LOC+14+5023949670870::9' QTY+83:0'LOC+14+5023949670870::9'QTY+17:7'LOC+14+5 023949692755::9'QTY+198:0'LOC+14+5023949692755::9' QTY+83:0'LOC+14+5023949692755::9'QTY+17:5'LOC+14+5 023949701028::9'QTY+198:0'LOC+14+5023949701028::9' QTY+83:0'LOC+14+5023949701028::9'QTY+17:15'LOC+14+ 5023949764661::9'QTY+198:0'LOC+14+5023949764661::9 'QTY+83:0'LOC+14+5023949764661::9'QTY+17:5'LOC+14+ 5023949771634::9'QTY+198:0'LOC+14+5023949771634::9 'QTY+83:0'LOC+14+5023949771634::9'QTY+17:87'LOC+18 +5023949825700::9'QTY+17:3'LOC+14+5023949832131::9 'QTY+198:0'LOC+14+5023949832131::9'QTY+83:0'LOC+14 +5023949832131::9'QTY+17:4'LOC+14+5023949833970::9 'QTY+198:0'LOC+14+5023949833970::9'QTY+83:0'LOC+14 +5023949833970::9'QTY+17:3'LOC+14+5023949843304::9 'QTY+198:0'LOC+14+5023949843304::9'QTY+83:0'LOC+14 +5023949843304::9'QTY+17:11'LOC+14+5023949867056:: 9'QTY+198:0'LOC+14+5023949867056::9'QTY+83:0'LOC+1 4+5023949867056::9'QTY+17:4'LOC+14+5023949912859:: 9'QTY+198:0'LOC+14+5023949912859::9'QTY+83:0'LOC+1 4+5023949912859::9'QTY+17:4'LOC+14+5023949929392:: 9'QTY+198:0'LOC+14+5023949929392::9'QTY+83:0'LOC+1 4+5023949929392::9'QTY+17:1'LOC+14+5023949955601:: 9'QTY+198:0'LOC+14+5023949955601::9'QTY+83:0'LOC+1 4+5023949955601::9'QTY+17:6'LOC+14+5023949962472:: 9'QTY+198:0'LOC+14+5023949962472::9'QTY+83:0'LOC+1 4+5023949962472::9'LIN+66 It has become apparant as we have worked with this string that they are giving a QTY followed by the LOC each time, when a LOC+18 appears it seems to be a lone value. LIN - EAN - QTY17 - LOC - QTY198 - LOC - QTY83 - LOC or when a lone warehouse entry is in the line: 'QTY+17:9'LOC+18+5023949825700::9'QTY+17:3'LOC+14+ 5023949833970::9'QTY+198:0'LOC+14+5023949833970::9 'QTY+83:0'LOC+14+5023949833970::9' So the 5023949825700 is Qty+17:9 starting to make more sense. Just like to say you have been a fantastic help with the two text files, I am slowly understanding more of how you have got the code to work, at least i have the worlds allocation of snippets to play with once i have these complete. Brian "Tom Ogilvy" wrote in message ... Sub testme3() Dim FName As String Dim FNum As Long Dim l As String Dim l1 As Variant Dim s As String Dim sChr As String Dim rng1 As Range, rng As Range Dim cell As Range, iloc As Long Columns("A:M").ClearContents Columns(3).NumberFormat = _ "0000000000000" FName = "C:\SLSRPT2.txt" FNum = FreeFile Open FName For Input As FNum Line Input #FNum, s s = Replace(s, Chr(9), "") l = s l = Replace(l, "LIN+", "LIN+,") l = Replace(l, "LOC", "LIN+,,") l = Replace(l, ":EN'QTY+17:", ",") l = Replace(l, "::9'QTY+17:", ",17,") l = Replace(l, "::9'QTY+83:", ",83,") l = Replace(l, "::9'QTY+198:", ",198,") l = Replace(l, "'", "") ' l = Replace(l, "+", ",") l1 = Split(l, "LIN+") Cells(1, 1).Resize(UBound(l1) - _ LBound(l1) + 1).Value = Application. _ Transpose(l1) Close #FNum Rows(1).Delete Columns(1).Replace "++", "," Columns(1).TextToColumns _ Destination:=Range("A1"), _ 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)) Set rng2 = Range(Cells(1, 2), _ Cells(Rows.Count, 2).End(xlUp)) For Each cell In rng2.SpecialCells(xlConstants) cell.Offset(0, -1).Delete Shift:=xlShiftToLeft Next Set cell = Cells(Rows.Count, "C").End(xlUp) lastrow = cell.Row If InStr(1, cell, "UNT", vbTextCompare) 0 Then cell = Left(cell, InStr(1, cell, "UNT", vbTextCompare) - 1) End If For i = 1 To cell.Row Set cell1 = Cells(i, "C") If Len(Trim(cell1)) 5 Then iloc = InStr(1, cell1, "+", vbTextCompare) Do While iloc 0 cell1.Value = Mid(cell1, iloc + 1, 255) iloc = InStr(1, cell1, "+", vbTextCompare) Loop If Right(cell1, 3) = "::9" Then cell1.Value = Replace(cell1, "::9", "") End If Else cell1.ClearContents End If Next Set rng = Nothing OldEan = "" For i = 2 To lastrow If Cells(i, 3) < "" Then If Cells(i, 3) < OldEan Then OldEan = Cells(i, 3) firstrow = i Else If rng Is Nothing Then Set rng = Cells(i, 3) Else Set rng = Union(rng, Cells(i, 3)) End If End If If CLng(Cells(i, "D")) = 17 Then col = 8 ElseIf CLng(Cells(i, "D")) = 198 Then col = 6 ElseIf CLng(Cells(i, "D")) = 83 Then col = 7 End If If Trim(Cells(i, "E")) < "" Then Cells(firstrow, col) = Cells(i, "E") Else If rng Is Nothing Then Set rng = Cells(i, "C") Else Set rng = Union(rng, Cells(i, "C")) End If End If End If Next rng.EntireRow.Delete Set rng = Columns(2).SpecialCells(xlBlanks) rng.Formula = "=" & rng(1).Offset(-1, 0).Address(0, 0) Set rng = Range(Cells(1, 2), _ Cells(Rows.Count, 2).End(xlUp)) rng.Formula = rng.Value Set rng = Columns(3).SpecialCells(xlBlanks) rng.EntireRow.Delete Columns("D:E").Delete Columns("A:A").Delete Range("A1:E1").Value = Array( _ "EAN", "LOC", "QTY198", "QTY83", "QTY17") End Sub -- Regards, Tom Ogilvy |
Import long string (modified Tom O snippet help!)
I have been playing round with the script a little and by doing the
following have managed to get the data onto the correct rows (baciscally by putting the line break on QTY rather than LOC), not as pretty as your solution l = Replace(l, "LIN+", "LIN+,") l = Replace(l, "QTY+", "LIN+,") l = Replace(l, ":EN'", " ") l = Replace(l, "17:", ",17,") l = Replace(l, "83:", ",83,") l = Replace(l, "198:", ",198,") l = Replace(l, "LOC+14+", ",") l = Replace(l, "LOC+18+", ",") l = Replace(l, "::9", "") l = Replace(l, "'", "") ' l = Replace(l, "+", ",") l1 = Split(l, "LIN+") I changed the above which basically put my data on the correct line... i am sure this could be done better and prettier but this actually appeared to get the Qty17 immediately after the EAN to correctly put itself on the same row as its first LOC in the group of 3, obviously having the Qty's before the LOC code is a pain, Results: so now i get ( i would prefer to have the format as before but looking at the next part of the code for how that manipulation was done.) ,1++21298776 ,,17,1,5023949771634 ,,198,0,5023949771634 ,,83,0,5023949771634 ,2++21326806 etc.... Brian "Brian" wrote in message ... Hi Tom, been looking at the results and found the following 'LIN+1++21298776:EN'QTY+17:1'LOC+14+5023949771634: :9'QTY+198:0'LOC+14+5023949771634::9'QTY+83:0'LOC+ 14+5023949771634::9 If you look at the line above it appears that the QTY+17 immediately after the :EN is related to the next LOC... So they appear to have a text format like : LIN - EAN - QTY17 - LOC - QTY198 - LOC - QTY83 - LOC They appear to be giving the values in the QTY followed by the LOC, When i ran the code it was out on the QTY17 by one place each time. This became very apparant when LOC+14 (Store) and LOC+18 (Warehouse) was displayed. Also noticed that the LOC column still included the prefix (which i would prefer to strip and just leave the 13 digit code) =14+ (store identifier) =18+ (Warehouse identifier) Looking at the code i assume that the line l = Replace(l, ":EN'QTY+17:", ",") and the would have to be modified. Also it makes it more complicated when multiple locations have a product as then i also have l = Replace(l, "::9'QTY+17:", ",17,") to contend with. Does this make sense ? I can see what i mean, just not sure i explained it very well... Brian "Tom Ogilvy" wrote in message ... Sub testme3() Dim FName As String Dim FNum As Long Dim l As String Dim l1 As Variant Dim s As String Dim sChr As String Dim rng1 As Range, rng As Range Dim cell As Range, iloc As Long Columns("A:M").ClearContents Columns(3).NumberFormat = _ "0000000000000" FName = "C:\SLSRPT2.txt" FNum = FreeFile Open FName For Input As FNum Line Input #FNum, s s = Replace(s, Chr(9), "") l = s l = Replace(l, "LIN+", "LIN+,") l = Replace(l, "LOC", "LIN+,,") l = Replace(l, ":EN'QTY+17:", ",") l = Replace(l, "::9'QTY+17:", ",17,") l = Replace(l, "::9'QTY+83:", ",83,") l = Replace(l, "::9'QTY+198:", ",198,") l = Replace(l, "'", "") ' l = Replace(l, "+", ",") l1 = Split(l, "LIN+") Cells(1, 1).Resize(UBound(l1) - _ LBound(l1) + 1).Value = Application. _ Transpose(l1) Close #FNum Rows(1).Delete Columns(1).Replace "++", "," Columns(1).TextToColumns _ Destination:=Range("A1"), _ 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)) Set rng2 = Range(Cells(1, 2), _ Cells(Rows.Count, 2).End(xlUp)) For Each cell In rng2.SpecialCells(xlConstants) cell.Offset(0, -1).Delete Shift:=xlShiftToLeft Next Set cell = Cells(Rows.Count, "C").End(xlUp) lastrow = cell.Row If InStr(1, cell, "UNT", vbTextCompare) 0 Then cell = Left(cell, InStr(1, cell, "UNT", vbTextCompare) - 1) End If For i = 1 To cell.Row Set cell1 = Cells(i, "C") If Len(Trim(cell1)) 5 Then iloc = InStr(1, cell1, "+", vbTextCompare) Do While iloc 0 cell1.Value = Mid(cell1, iloc + 1, 255) iloc = InStr(1, cell1, "+", vbTextCompare) Loop If Right(cell1, 3) = "::9" Then cell1.Value = Replace(cell1, "::9", "") End If Else cell1.ClearContents End If Next Set rng = Nothing OldEan = "" For i = 2 To lastrow If Cells(i, 3) < "" Then If Cells(i, 3) < OldEan Then OldEan = Cells(i, 3) firstrow = i Else If rng Is Nothing Then Set rng = Cells(i, 3) Else Set rng = Union(rng, Cells(i, 3)) End If End If If CLng(Cells(i, "D")) = 17 Then col = 8 ElseIf CLng(Cells(i, "D")) = 198 Then col = 6 ElseIf CLng(Cells(i, "D")) = 83 Then col = 7 End If If Trim(Cells(i, "E")) < "" Then Cells(firstrow, col) = Cells(i, "E") Else If rng Is Nothing Then Set rng = Cells(i, "C") Else Set rng = Union(rng, Cells(i, "C")) End If End If End If Next rng.EntireRow.Delete Set rng = Columns(2).SpecialCells(xlBlanks) rng.Formula = "=" & rng(1).Offset(-1, 0).Address(0, 0) Set rng = Range(Cells(1, 2), _ Cells(Rows.Count, 2).End(xlUp)) rng.Formula = rng.Value Set rng = Columns(3).SpecialCells(xlBlanks) rng.EntireRow.Delete Columns("D:E").Delete Columns("A:A").Delete Range("A1:E1").Value = Array( _ "EAN", "LOC", "QTY198", "QTY83", "QTY17") End Sub -- Regards, Tom Ogilvy |
Import long string (modified Tom O snippet help!)
|
Import long string (modified Tom O snippet help!) FINAL RESULT...
Thanks ever so much Tom, your help was greatly appreciated.
I tied all this up it now works excellent! It has saved me many hours every Monday to produce a readable report for one user!!! Like I said, anyone who needs to import EDI EANCOM data into excel will find these examples extremely useful!!!! Thanks again Tom!!! Brian INVRPT: (if you wish to parse the text for SLSRPT files see the earlier example on previous post) -------------------------------------------------------- On the worksheet i have... Sub GETINVRPT() Dim FName As String Dim FNum As Long Dim l As String Dim l1 As Variant Dim s As String Dim sChr As String Dim rng1 As Range, rng As Range Dim cell As Range, iloc As Long Columns("A:M").ClearContents Columns(6).NumberFormat = _ "0000000000000" FName = "C:\INVRPT.txt" FNum = FreeFile Open FName For Input As FNum Line Input #FNum, s s = Replace(s, Chr(9), "") l = s l = Replace(l, "LIN+", "LIN+,") l = Replace(l, "QTY+", "LIN+,,") l = Replace(l, "::9", "") l = Replace(l, "++", ",'") l = Replace(l, "'", "") l = Replace(l, ":EN", "") l = Replace(l, "LOC+", ",") l = Replace(l, "17:", "QTY 17,") l = Replace(l, "83:", "QTY 83,") l = Replace(l, "198:", "QTY 198,") l = Replace(l, "14+", "14,") l = Replace(l, "18+", "18,") l1 = Split(l, "LIN+") l1 = TransArr(l1) Cells(1, 1).Resize(UBound(l1, 1) - _ LBound(l1, 1) + 1).Value = l1 Close #FNum Rows(1).Delete Columns(1).TextToColumns _ Destination:=Range("A1"), _ DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, _ Tab:=True, _ 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)) Set rng2 = Range(Cells(1, 2), _ Cells(Rows.Count, 2).End(xlUp)) For Each cell In rng2.SpecialCells(xlConstants) cell.Offset(0, -1).Delete Shift:=xlShiftToLeft Next Set cell = Cells(Rows.Count, "F").End(xlUp) lastrow = cell.Row If InStr(1, cell, "UNT", vbTextCompare) 0 Then cell = Left(cell, InStr(1, cell, "UNT", vbTextCompare) - 1) End If Set rng2 = Range(Cells(1, 2), _ Cells(Rows.Count, 2).End(xlUp)) For Each cell In rng2 cell.Value = "'" & cell.Value Next Columns(6).NumberFormat = _ "0000000000000" Columns("C:D").Cut Columns("G").Insert Columns("C").Copy Columns("A") Columns("C").Delete Columns("E").NumberFormat = "General" Set cell = Cells(Rows.Count, "C").End(xlUp) lastrow = cell.Row For i = 2 To lastrow Set cell1 = Cells(i, "B") If Len(Trim(cell1)) < 3 Then cell1.Value = "'" & cell1.Offset(-1, 0).Value End If Next Set rng = Nothing OldEan = "" For i = 2 To lastrow If Cells(i, 3) < "" Then If Cells(i, 3) < OldEan Then OldEan = Cells(i, 3) firstrow = i Cells(firstrow, 8).Value = 0 End If If Cells(i, "D") = "QTY 17" Then col = 8 ElseIf Cells(i, "D") = "QTY 198" Then col = 6 ElseIf Cells(i, "D") = "QTY 83" Then col = 7 End If If Trim(Cells(i, "E")) < "" Then Cells(firstrow, col) = Cells(i, "E") + Cells(firstrow, col) End If End If Next Set rng = Columns(8).SpecialCells(xlBlanks) rng.EntireRow.Delete Rows(1).Insert Columns("D:E").Delete Columns("A:A").Delete Range("A1:E1").Value = Array( _ "EAN", "LOC", "QTY198", "QTY83", "QTY17") End Sub Public Function TransArr(v As Variant) Dim v1() As Variant ReDim v1(LBound(v) To UBound(v), 0 To 0) For i = LBound(v) To UBound(v) v1(i, 0) = v(i) Next TransArr = v1 End Function ---------------------------------------------------------------------------- Module is: Sub Macro1() ' ' Macro1 Macro ' Macro recorded 2/18/2006 by Thomas Ogilvy ' ' Columns("A:A").Select Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ 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)) Columns("F:F").EntireColumn.AutoFit End Sub -------------------------------------------------------------------------------------------- "Tom Ogilvy" wrote in message ... Brian, Hard to know where to jump in. If you want to send me a copy of the source file, I will see what I can discover on my own while you do your thing. You have the advantage of knowing what some of this stuff means. To me, it is just a line of characters and numbers. |
| All times are GMT +1. The time now is 08:36 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com