Excel vba: Browse to text file and split at each ~ on new row

Js Smith

New Member
Joined
Jul 24, 2020
Messages
44
Office Version
  1. 2010
Platform
  1. Windows
Hi all!

I am pretty sure this is just a small error but I cannot figure how to fix it. Goal is to have te user browse to a text file then the vba reads the data and using the delimiter ~, deposit each line on a new row.

So something like this:
~BGN*00*b7cc7cbcbfb54c59b185*20221012*081316*ET***2~QTY*ET*1~QTY*TO*1~N1*P5*ZUC ZOX*94*1000046934~N1*IN*TO YOUR POCKET*FI*930989307~INS*Y*18*024*59*A***TE~REF*17*1000046934~REF*23*M0064460900~REF*1L*38065~REF*ZZ*M00644609~REF*0F*1000046934~DTP*357*D8*20230331~NM1*IL*1*ZOX*ZUC~DMG*D8*19790131*M*R*:RET:1002-5*1~LUI*LD*ENG**6~LUI*LD*ENG**7~NM1*QD*1*ZOX*ZUC~PER*RP**TE*5555555555*EM*ZUC@MAIL.COM~N3*1111 ANY DRIVE~N4*SEATTLE*WA~LS*2700~LX*1~N1*75*MONTHLY PRE AMT TOT~REF*9X*288.00~DTP*007*D8*20230101~LX*2~N1*75*MONTHLY FEE AMT~REF*9X*0.00~DTP*007*D8*20230101~LX*3~N1*75*MONTHLY TOT RES AMT~REF*9X*288.00~DTP*007*D8*20230101~LX*4~N1*75*MONTHLY PRE AMT TOT~REF*9X*288.00~DTP*007*D8*20230201~LX*5~N1*75*MONTHLY FEE AMT~REF*9X*0.00~DTP*007*D8*20230201~LX*6~N1*75*MONTHLY TOT RES AMT

Becomes like this:
BGN*00*b7cc7cbcbfb54c59b185*20221012*081316*ET***2QTY*ET*1
QTY*TO*1
N1*P5*ZUC ZOX*94*1000046934
N1*IN*TOYOURPOCKET*FI*930989307
INS*Y*18*024*59*A***TE
REF*17*1000046934
REF*23*M0064460900
REF*1L*38065
REF*ZZ*M00644609
REF*0F*1000046934
DTP*357*D8*20230331
NM1*IL*1*ZOX*ZUC
DMG*D8*19790131*M*R*:RET:10025*1
LUI*LD*ENG**6
LUI*LD*ENG**7
NM1*QD*1*ZOX*ZUC
PER*RP**TE*5555555555*EM*ZUC@MAIL.COM
N3*1111 ANY DRIVE
N4*SEATTLE*WA
LS*2700
LX*1
N1*75*MONTHLY PRE AMT TOT
REF*9X*288.00DTP*007*D8*20230101
LX*2
N1*75*MONTHLY FEE AMT
REF*9X*0.00
DTP*007*D8*20230101
LX*3N1*75*MONTHLY TOT RES AMT
REF*9X*288.00
DTP*007*D8*20230101
LX*4
N1*75*MONTHLY PRE AMT TOT
REF*9X*288.00
DTP*007*D8*20230201
LX*5
N1*75*MONTHLY FEE AMT
REF*9X*0.00
DTP*007*D8*20230201
LX*6

This is my code. It's putting everything in cell A7 and I can work around it until the character length exceed the excel cell max:

VBA Code:
Dim Path As String
    
    Path = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Select a Text file", , False)
    Open Path For Input As #1
    r = 0
    Do Until EOF(1)
        Line Input #1, Data
        lines = Split(Data, "~")
        Worksheets("Sheet1").Range("A7").Offset(r, 0) = Data
        r = r + 1
    Loop
    Close #1

I am 99.99% sure the problem is an error on that split line. I appreciate you help on this! 😁
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Two methods

VBA Code:
Sub jec()
 Dim ar
 With Application.FileDialog(3)
   .Filters.Add "Text Files", "*.txt"
   If .Show = 0 Then Exit Sub
   Open .SelectedItems(1) For Input As #1
   ar = Split(Input(LOF(1), #1), "~")
   Close #1
   Sheets("Sheet1").Range("A7").Resize(UBound(ar)) = Application.Transpose(ar)
 End With
End Sub


VBA Code:
Sub jecc()
 Dim ar
 With Application.FileDialog(3)
   .Filters.Add "Text Files", "*.txt"
   If .Show = 0 Then Exit Sub
   ar = Split(CreateObject("scripting.filesystemobject").opentextfile(.SelectedItems(1)).readall, "~")
   Sheets("Sheet1").Range("A7").Resize(UBound(ar)) = Application.Transpose(ar)
 End With
End Sub
 
Upvote 0
Solution
Thanks JEC! That is great and FAST!
I will be picking this apart to learn more.
Hope you have a fantastic New Year. 🥳
 
Upvote 0
Thanks you too! Cheers :cool:
 
Upvote 0

Forum statistics

Threads
1,215,069
Messages
6,122,953
Members
449,095
Latest member
nmaske

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top