[VBA] Import CSV and split text based on custom delimiters or words

[MartinS13X]

I am trying to import a CSV file into excel via VBA and have it split the text into several columns based on "standard"-delimiters such as "," and also split it at certain words appearing in the text.

Below is an (edited) excerpt of the csv file:
(The current file is about 700 lines, but will become longer)

06/01/2019,Supermarket - Visa Purchase - Receipt 148833 Date 05 Jan 2019 Card xxxx,,-301.07,180.13
06/01/2019,Random Store - Visa Purchase - Receipt 148832 Date 04 Jan 2019 Card xxxx,,-153.66,481.20
05/01/2019,Shell Petrol Station - Visa Purchase - Receipt 144494 Date 04 Jan 2019 Card xxxx,,-115.14,634.86
04/01/2019,Money Transfer - Deposit - Date 04 Jan 2019, ,750.00,,0

Obviously, splitting the text on the "," delimiter gives me the 5 columns but I'd like to split the description further. One would think splitting it on "-" would work, but of course there's always this exception that messes things up.

If I could split the description on the words "Date" and "Card" (and/or other keywords/delimiters) it would help me a lot. So it would (probably) look like this:

[TABLE="class: grid, width: 750"]
<tbody>[TR]
[TD]06/01/2019[/TD]
[TD]Supermarket - Visa Purchase - Receipt 14883[/TD]
[TD]05 Jan 2019[/TD]
[TD]xxxx[/TD]
[TD][/TD]
[TD]-301.07[/TD]
[TD]180.13[/TD]
[/TR]
[TR]
[TD]06/01/2019[/TD]
[TD]Random store - Visa Purchase - Receipt 148832[/TD]
[TD]04 Jan 2019[/TD]
[TD]xxxx[/TD]
[TD][/TD]
[TD]-153.66[/TD]
[TD]481.20[/TD]
[/TR]
[TR]
[TD]05/01/2019[/TD]
[TD]Shell Petrol Station - Visa Purchase - Receipt 144494[/TD]
[TD]04 Jan 2019[/TD]
[TD]xxxx[/TD]
[TD][/TD]
[TD]-115.14[/TD]
[TD]634.86[/TD]
[/TR]
[TR]
[TD]04/01/2019[/TD]
[TD]Money Transfer - Deposit[/TD]
[TD]04 Jan 2019[/TD]
[TD][/TD]
[TD]750[/TD]
[TD][/TD]
[TD]0.00[/TD]
[/TR]
</tbody>[/TABLE]



Thanks in advance...

 

[alansidman]

Power Query Use MCode


Open Power Query/Get and Transform. Click on New Query. Make sure that your raw data is in a table and it is name Table1

Open blank query in the editor, launch Advanced Editor and paste in the following code.

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Column1", type text}}),
    #"Split Column by Delimiter" = Table.SplitColumn(#"Changed Type", "Column1", Splitter.SplitTextByDelimiter(",", QuoteStyle.Csv), {"Column1.1", "Column1.2", "Column1.3", "Column1.4", "Column1.5", "Column1.6"}),
    #"Changed Type1" = Table.TransformColumnTypes(#"Split Column by Delimiter",{{"Column1.1", type date}, {"Column1.2", type text}, {"Column1.3", type text}, {"Column1.4", type number}, {"Column1.5", type number}, {"Column1.6", Int64.Type}}),
    #"Split Column by Delimiter1" = Table.SplitColumn(#"Changed Type1", "Column1.2", Splitter.SplitTextByEachDelimiter({"Date"}, QuoteStyle.Csv, false), {"Column1.2.1", "Column1.2.2"}),
    #"Changed Type2" = Table.TransformColumnTypes(#"Split Column by Delimiter1",{{"Column1.2.1", type text}, {"Column1.2.2", type text}}),
    #"Split Column by Delimiter2" = Table.SplitColumn(#"Changed Type2", "Column1.2.2", Splitter.SplitTextByEachDelimiter({"Card"}, QuoteStyle.Csv, false), {"Column1.2.2.1", "Column1.2.2.2"}),
    #"Changed Type3" = Table.TransformColumnTypes(#"Split Column by Delimiter2",{{"Column1.2.2.1", type date}, {"Column1.2.2.2", type text}}),
    #"Removed Columns" = Table.RemoveColumns(#"Changed Type3",{"Column1.3", "Column1.6"})
in
    #"Removed Columns"

 

[MartinS13X]

I probably should have mentioned I want to import the file from the hard disk...

Found this little piece of code during some internet sleuthing. It basically does what I want, only with one delimiter and way too slow.

Public FSO As New FileSystemObject
Sub Import_CSV()
Dim WrdArray() As String
Dim txtstrm As TextStream
Dim line As String
Dim clm As Long
Dim Rw As Long
Set txtstrm = FSO.OpenTextFile("D:\!Excel_Docs\!ING-Transactions\Transactions.csv")
Rw = 1
Do Until txtstrm.AtEndOfStream
  line = txtstrm.ReadLine
  clm = 1
  WrdArray() = Split(line, ",")
  For Each wrd In WrdArray()
    ActiveSheet.Cells(Rw, clm) = wrd
    clm = clm + 1
  Next wrd
  Rw = Rw + 1
Loop
txtstrm.Close
End Sub

 

[MartinS13X]

Power Query Use MCode


Open Power Query/Get and Transform. Click on New Query. Make sure that your raw data is in a table and it is name Table1

Open blank query in the editor, launch Advanced Editor and paste in the following code.

[...]

OMG.... How is it possible I had never heard of this before?? This is awesome.
Sorry for the slow reply. Had to play around with it a bit.

Should be able to make this work and more!! Will have revisit some other workbooks and simplify some stuff.

 

[MartinS13X]

Power Query Use MCode


Open Power Query/Get and Transform. Click on New Query. Make sure that your raw data is in a table and it is name Table1

Open blank query in the editor, launch Advanced Editor and paste in the following code.

[...]

I haven't even scratched the surface of what's possible with this power query thing but have already re-started my current project, basically putting a macro and files I've been using since 2012 in the bin.

Without going into a long description what I want to do, this is saving me so much time (mostly googling. lol)
Anyways, Thanks again. Big thumbs up!!