Data Text to Column

decent_boy · May 20, 2020

Hi
I copy below data from a text file and issue is that when I convert/copy multiple rows to Result Sheet, it takes too much time. Please provide any VBA solution to save time

Date Copied from Text File
Sheet1

	A
1	Order No = A25/CP/0123/00333
2	Order Amount = 12351
3	SH_ID = TA5
4
5	-------------------------------------------------------------------------------------------------------------------------------------------------------------
6	\| SP \|Type \|Denomination \|From \|To \| Quantity\| \|
7	-------------------------------------------------------------------------------------------------------------------------------------------------------------
8	\|DS1\|EU \|ITEM-232 \|0101250300225100 \|0101250300225199 \| 100\|SMITH \|
9	\|DS1\|EU \|ITEM-324 \|0600528600210000 \|0600528600210199 \| 200\|SMITH \|
10	\|DS1\|EU \|ITEM-524 \|0005084901091890 \|0005084901091919 \| 30\|SMITH \|
11
12	Order No = A32/CP/0152/00352
13	Order Amount = 726
14	SH_ID = TA9
15
16	-------------------------------------------------------------------------------------------------------------------------------------------------------------
17	\| SP \|Type \|Denomination \|From \|To \| Quantity\| \|
18	-------------------------------------------------------------------------------------------------------------------------------------------------------------
19	\|DS2\|EU \|ITEM-232 \|0101250300225200 \|0101250300225299 \| 100\|JHON \|
20
21	Order No = A33/CP/0192/00395
22	Order Amount = 8252
23	SH_ID = TA2
24
25	-------------------------------------------------------------------------------------------------------------------------------------------------------------
26	\| SP \|Type \|Denomination \|From \|To \| Quantity\| \|
27	-------------------------------------------------------------------------------------------------------------------------------------------------------------
28	\|DS3\|EU \|ITEM-232 \|0101250300225300 \|0101250300225399 \| 100\|Phenny \|
29	\|DS3\|EU \|ITEM-324 \|0600528600210200 \|0600528600210399 \| 200\|Phenny \|

Required result after removing unnecessary space

Result

	A	B	C	D	E	F	G
1	Date	SH_ID	Order No	Quantity	Denomination	From	To
2	20-May-20	TA5	A25/CP/0123/00333	100	ITEM-232	0101250300225100	0101250300225199
3	20-May-20	TA5	A25/CP/0123/00333	200	ITEM-324	0600528600210000	0600528600210199
4	20-May-20	TA5	A25/CP/0123/00333	30	ITEM-524	0005084901091890	0005084901091919
5	20-May-20	TA9	A32/CP/0152/00352	100	ITEM-232	0101250300225200	0101250300225299
6	20-May-20	TA2	A33/CP/0192/00395	100	ITEM-232	0101250300225300	0101250300225399
7	20-May-20	TA2	A33/CP/0192/00395	200	ITEM-324	0600528600210200	0600528600210399

Excel tables to the web >> Excel Jeanie HTML 4

GraH · May 23, 2020

Hi,

I know you asked for VBA, but depending on your Excel version (tip: update your profile so we all know) a good alternative may be to use Power Query. I've copied your sample data roughly 6500 times to have some kind of stress test. Refreshing takes 8 counts. This can still be speeded-up if needed.

Code:

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    AddIndex1 = Table.AddIndexColumn(Source, "Index", 1, 1),
    SetPartitionIndexWhereOrderStarts = Table.AddColumn(AddIndex1, "Partition", each if Text.StartsWith([Column1], "Order No") then [Index] else null),
    FilterOutNulls_Blanks = Table.SelectRows(SetPartitionIndexWhereOrderStarts, each [Column1] <> null and not Text.StartsWith([Column1], "----") and not Text.StartsWith([Column1], "| SP")),
    FillDownPartitionIndex = Table.FillDown(FilterOutNulls_Blanks,{"Partition"}),
    GroupOnPartitionIndex_All = Table.Group(FillDownPartitionIndex, {"Partition"}, {{"All", each _, type table [Column1=text, Index=number, Partition=number]}}),
    NormalizePart1 = Table.AddColumn(GroupOnPartitionIndex_All, "Partition1", each Table.PromoteHeaders(Table.Transpose(Table.SelectColumns(Table.SplitColumn(Table.FirstN([All],3), "Column1", Splitter.SplitTextByEachDelimiter({" = "}, QuoteStyle.Csv, false), {"Header", "Content"}),{"Header", "Content"})))),
    NormalizePart2 = Table.AddColumn(NormalizePart1, "Partition2", each Table.SplitColumn(Table.SelectColumns(Table.RemoveFirstN([All],3),"Column1")
, "Column1", Splitter.SplitTextByDelimiter("|", QuoteStyle.Csv), {"empty", "SP", "Type", "Denomination", "From", "To", "Quantity", "Name"})),
    KeepPartitions = Table.SelectColumns(NormalizePart2,{"Partition1", "Partition2"}),
    ExpandPartition1 = Table.ExpandTableColumn(KeepPartitions, "Partition1", {"Order No", "Order Amount", "SH_ID"}, {"Order No", "Order Amount", "SH_ID"}),
    ExpandPartition2 = Table.ExpandTableColumn(ExpandPartition1, "Partition2", {"SP", "Type", "Denomination", "From", "To", "Quantity"}, {"SP", "Type", "Denomination", "From", "To", "Quantity"})
in
    ExpandPartition2

Note, if you have the text file, PQ can read and transform directly from the text file. I copied the sample in a text file called OrderData.Txt.

Code:

let
    Source = Csv.Document(File.Contents("G:\OrderData.txt"),1,"{}{}{}",null,1252),
    AddIndex1 = Table.AddIndexColumn(Source, "Index", 1, 1),
    SetPartitionIndexWhereOrderStarts = Table.AddColumn(AddIndex1, "Partition", each if Text.StartsWith([Column1], "Order No") then [Index] else null),
    FilterOutNulls_Blanks = Table.SelectRows(SetPartitionIndexWhereOrderStarts, each [Column1] <> null and not Text.StartsWith([Column1], "----") and not Text.StartsWith([Column1], "| SP") and [Column1] <> ""),
    FillDownPartitionIndex = Table.FillDown(FilterOutNulls_Blanks,{"Partition"}),
    GroupOnPartitionIndex_All = Table.Group(FillDownPartitionIndex, {"Partition"}, {{"All", each _, type table [Column1=text, Index=number, Partition=number]}}),
    NormalizePart1 = Table.AddColumn(GroupOnPartitionIndex_All, "Partition1", each Table.PromoteHeaders(Table.Transpose(Table.SelectColumns(Table.SplitColumn(Table.FirstN([All],3), "Column1", Splitter.SplitTextByEachDelimiter({" = "}, QuoteStyle.Csv, false), {"Header", "Content"}),{"Header", "Content"})))),
    NormalizePart2 = Table.AddColumn(NormalizePart1, "Partition2", each Table.SplitColumn(Table.SelectColumns(Table.RemoveFirstN([All],3),"Column1")
, "Column1", Splitter.SplitTextByDelimiter("|", QuoteStyle.Csv), {"empty", "SP", "Type", "Denomination", "From", "To", "Quantity", "Name"})),
    KeepPartitions = Table.SelectColumns(NormalizePart2,{"Partition1", "Partition2"}),
    ExpandPartition1 = Table.ExpandTableColumn(KeepPartitions, "Partition1", {"Order No", "Order Amount", "SH_ID"}, {"Order No", "Order Amount", "SH_ID"}),
    ExpandPartition2 = Table.ExpandTableColumn(ExpandPartition1, "Partition2", {"SP", "Type", "Denomination", "From", "To", "Quantity"}, {"SP", "Type", "Denomination", "From", "To", "Quantity"}),
    ChangeDataTypesAllCols = Table.TransformColumnTypes(ExpandPartition2,{{"Quantity", Int64.Type}, {"Order Amount", type number}, {"To", type text}, {"From", type text}, {"Denomination", type text}, {"Type", type text}, {"SP", type text}, {"SH_ID", type text}, {"Order No", type text}})
in
    ChangeDataTypesAllCols

It might require some minor adjustments to the real life situation.

Result sample

EDIT: just noticed I don't have the date column, but that does not come from the data source does it?

Peter_SSs · May 24, 2020

GraH said:
EDIT: just noticed I don't have the date column, but that does not come from the data source does it?

I am also assuming not & I have included the current date as the first column.

GraH said:
I've copied your sample data roughly 6500 times to have some kind of stress test. Refreshing takes 8 counts.

I have done a similar test with the code below. The result was just less than 1 second.

VBA Code:

Sub Rearrange()
  Dim a As Variant, b As Variant, Bits As Variant
  Dim i As Long, k As Long
  Dim sID As String, sOrder As String, s As String
  Dim dteDate As Date
 
  dteDate = Date
  a = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 7)
  For i = 1 To UBound(a)
    s = UCase(a(i, 1))
    Select Case True
      Case s Like "ORDER NO*": sOrder = Trim(Split(a(i, 1), "=")(1))
      Case s Like "SH_ID*": sID = Trim(Split(a(i, 1), "=")(1))
      Case s Like "|DS*"
        Bits = Split(s, "|")
        k = k + 1
        b(k, 1) = dteDate
        b(k, 2) = sID
        b(k, 3) = sOrder
        b(k, 4) = Val(Bits(6))
        b(k, 5) = Bits(3)
        b(k, 6) = Bits(4)
        b(k, 7) = Bits(5)
    End Select
  Next i
  With Range("C1:I1")
    .Value = Array("Date", "SH_ID", "Order No", "Quantity", "Denomination", "From", "To")
    With .Offset(1).Resize(k)
      .NumberFormat = "@"
      .Columns(1).NumberFormat = "dd-mmm-yy"
      .Columns(4).NumberFormat = "General"
      .Value = b
    End With
    .EntireColumn.AutoFit
  End With
End Sub

My sample data and results:

decent_boy 2020-05-24 1.xlsm

A

B

C

D

E

F

G

H

I

1

Order No = A25/CP/0123/00333

Date

SH_ID

Order No

Quantity

Denomination

From

To

2

Order Amount = 12351

24-May-20

TA5

A25/CP/0123/00333

100

ITEM-232

0101250300225100

0101250300225199

3

SH_ID = TA5

24-May-20

TA5

A25/CP/0123/00333

200

ITEM-324

0600528600210000

0600528600210199

4

24-May-20

TA5

A25/CP/0123/00333

30

ITEM-524

0005084901091890

0005084901091919

5

-------------------------------------------------------------------------------------------------------------------------------------------------------------

24-May-20

TA9

A32/CP/0152/00352

100

ITEM-232

0101250300225200

0101250300225299

6

24-May-20

TA2

A33/CP/0192/00395

100

ITEM-232

0101250300225300

0101250300225399

7

-------------------------------------------------------------------------------------------------------------------------------------------------------------

24-May-20

TA2

A33/CP/0192/00395

200

ITEM-324

0600528600210200

0600528600210399

8

|DS1|EU |ITEM-232 |0101250300225100 |0101250300225199 | 100|SMITH |

9

|DS1|EU |ITEM-324 |0600528600210000 |0600528600210199 | 200|SMITH |

10

|DS1|EU |ITEM-524 |0005084901091890 |0005084901091919 | 30|SMITH |

11

12

Order No = A32/CP/0152/00352

13

Order Amount = 726

14

SH_ID = TA9

15

16

-------------------------------------------------------------------------------------------------------------------------------------------------------------

17

18

-------------------------------------------------------------------------------------------------------------------------------------------------------------

19

|DS2|EU |ITEM-232 |0101250300225200 |0101250300225299 | 100|JHON |

20

21

Order No = A33/CP/0192/00395

22

Order Amount = 8252

23

SH_ID = TA2

24

25

-------------------------------------------------------------------------------------------------------------------------------------------------------------

26

27

-------------------------------------------------------------------------------------------------------------------------------------------------------------

28

|DS3|EU |ITEM-232 |0101250300225300 |0101250300225399 | 100|Phenny |

29

|DS3|EU |ITEM-324 |0600528600210200 |0600528600210399 | 200|Phenny |

Sheet1

GraH · May 24, 2020

Peter_SSs said:
I am also assuming not & I have included the current date as the first column.

I have done a similar test with the code below. The result was just less than 1 second.

That happens when you know how to write performant code, so

. That's not me so I settle for PQ. BTW, I've tried to improve the performance of the PQ using Table.Buffer, but it does not reduce the run time.

decent_boy · May 29, 2020

Peter_SSs said:
I am also assuming not & I have included the current date as the first column.

I have done a similar test with the code below. The result was just less than 1 second.

VBA Code:

Sub Rearrange() Dim a As Variant, b As Variant, Bits As Variant Dim i As Long, k As Long Dim sID As String, sOrder As String, s As String Dim dteDate As Date dteDate = Date a = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value ReDim b(1 To UBound(a), 1 To 7) For i = 1 To UBound(a) s = UCase(a(i, 1)) Select Case True Case s Like "ORDER NO*": sOrder = Trim(Split(a(i, 1), "=")(1)) Case s Like "SH_ID*": sID = Trim(Split(a(i, 1), "=")(1)) Case s Like "|DS*" Bits = Split(s, "|") k = k + 1 b(k, 1) = dteDate b(k, 2) = sID b(k, 3) = sOrder b(k, 4) = Val(Bits(6)) b(k, 5) = Bits(3) b(k, 6) = Bits(4) b(k, 7) = Bits(5) End Select Next i With Range("C1:I1") .Value = Array("Date", "SH_ID", "Order No", "Quantity", "Denomination", "From", "To") With .Offset(1).Resize(k) .NumberFormat = "@" .Columns(1).NumberFormat = "dd-mmm-yy" .Columns(4).NumberFormat = "General" .Value = b End With .EntireColumn.AutoFit End With End Sub

My sample data and results:

decent_boy 2020-05-24 1.xlsm
A B C D E F G H I
1 Order No = A25/CP/0123/00333 Date SH_ID Order No Quantity Denomination From To
2 Order Amount = 12351 24-May-20 TA5 A25/CP/0123/00333 100 ITEM-232 0101250300225100 0101250300225199
3 SH_ID = TA5 24-May-20 TA5 A25/CP/0123/00333 200 ITEM-324 0600528600210000 0600528600210199
4 24-May-20 TA5 A25/CP/0123/00333 30 ITEM-524 0005084901091890 0005084901091919
5 ------------------------------------------------------------------------------------------------------------------------------------------------------------- 24-May-20 TA9 A32/CP/0152/00352 100 ITEM-232 0101250300225200 0101250300225299
6 | SP |Type |Denomination |From |To | Quantity| | 24-May-20 TA2 A33/CP/0192/00395 100 ITEM-232 0101250300225300 0101250300225399
7 ------------------------------------------------------------------------------------------------------------------------------------------------------------- 24-May-20 TA2 A33/CP/0192/00395 200 ITEM-324 0600528600210200 0600528600210399
8 |DS1|EU |ITEM-232 |0101250300225100 |0101250300225199 | 100|SMITH |
9 |DS1|EU |ITEM-324 |0600528600210000 |0600528600210199 | 200|SMITH |
10 |DS1|EU |ITEM-524 |0005084901091890 |0005084901091919 | 30|SMITH |
11
12 Order No = A32/CP/0152/00352
13 Order Amount = 726
14 SH_ID = TA9
15
16 -------------------------------------------------------------------------------------------------------------------------------------------------------------
17 | SP |Type |Denomination |From |To | Quantity| |
18 -------------------------------------------------------------------------------------------------------------------------------------------------------------
19 |DS2|EU |ITEM-232 |0101250300225200 |0101250300225299 | 100|JHON |
20
21 Order No = A33/CP/0192/00395
22 Order Amount = 8252
23 SH_ID = TA2
24
25 -------------------------------------------------------------------------------------------------------------------------------------------------------------
26 | SP |Type |Denomination |From |To | Quantity| |
27 -------------------------------------------------------------------------------------------------------------------------------------------------------------
28 |DS3|EU |ITEM-232 |0101250300225300 |0101250300225399 | 100|Phenny |
29 |DS3|EU |ITEM-324 |0600528600210200 |0600528600210399 | 200|Phenny |
Sheet1

Thank you very much Peter_SSs, it has worked well, as I asked

Peter_SSs · May 29, 2020

decent_boy said:
Thank you very much Peter_SSs, it has worked well, as I asked

You're welcome. Thanks for the follow-up.

decent_boy · Jun 9, 2020

Peter_SSs said:
You're welcome. Thanks for the follow-up.

Hi
Peter_SSs
I am facing an issue to run your provided above code when i use following macro to extract email data, it copies one email data in one cell and the macro, you provided, does not work on it. Further I change SH_ID into Franchise ID then this column data becomes blank.

Macro Link: How To Import Your Outlook Emails Into Excel With VBA | How To Excel

Code:

Sub GetFromOutlook()

Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
Dim i As Integer

Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("DPC")

    Range("A4:D4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents

i = 1

For Each OutlookMail In Folder.Items
    If OutlookMail.ReceivedTime >= Range("From_date").Value Then
    Range("eMail_text").Offset(i, 0).Value = OutlookMail.Body
        
        i = i + 1
    End If
Next OutlookMail

Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing

End Sub

Peter_SSs · Jun 9, 2020

decent_boy said:
I am facing an issue to run your provided above code when i use following macro to extract email data, it copies one email data in one cell and the macro, you provided, does not work on it. Further I change SH_ID into Franchise ID then this column data becomes blank.

Then you would need to provide some new relevant sample data (say 4-5 rows to show any variations) and the expected results, preferably with XL2BB

decent_boy · Jun 12, 2020

Please find some new relevant sample data 2 rows

Extract Emails.xlsm

A

1

Order No = A25/CP/0123/00333 Order Amount = 12351 Franchise ID = YT500 ------------------------------------------------------------------------------------------------------------------------------------------------------------- | SP |Type |Denomination |From |To | Quantity|Salesman | ------------------------------------------------------------------------------------------------------------------------------------------------------------- |DS3|EU |Item-232 |0009000567370400 |0009000567371599 | 1200|Smith | DS3|EU |Item-526 |1009000649009500 |1009000649009599 | 100|Simth | ------------------------------------------------------------------------------------------------------------------------------------------------------------ Total 1300 Franchise ID = YT500 Franchise Name = Zebist Address = XYZ = City = Limsha Phone#1 = Phone#2 = Store ID = CHLIA . .

2

Order No = A33/CP/0192/00395 Order Amount = 92584 Franchise ID = TA9 ------------------------------------------------------------------------------------------------------------------------------------------------------------- | SP | Type |Denomination |From |To | Quantity|Salesman | ------------------------------------------------------------------------------------------------------------------------------------------------------------- |DS3|EU |Item-526 |0009000559300800 |0009000559301099 | 300|Decent | |DS3|EU |Item-100 |0009000567371600 |0009000567373999 | 2400|Decent | |DS3|EU |Item-400 |1009000649009600 |1009000649009899 | 300|Decent | ------------------------------------------------------------------------------------------------------------------------------------------------------------ Total 3000 Franchise ID = Franchise ID = TA9 Franchise Name = JB Address = Hosheen. = City = Hosheen Phone#1 = Phone#2 = Store ID = . .

Sheet2

Expected Result

Extract Emails.xlsm

A

B

C

D

E

F

G

1

Date

Franchise ID

Order No

Quantity

Denomination

From

To

2

12-Jun-20

YT500

A25/CP/0123/00333

1200

ITEM-232

0009000567370400

0009000567371599

3

12-Jun-20

YT500

A25/CP/0123/00333

100

ITEM-526

1009000649009500

1009000649009599

4

12-Jun-20

TA9

A33/CP/0192/00395

300

ITEM-526

0009000559300800

0009000559301099

5

12-Jun-20

TA9

A33/CP/0192/00395

2400

ITEM-100

0009000567371600

0009000567373999

6

12-Jun-20

TA9

A33/CP/0192/00395

300

ITEM-400

1009000649009600

1009000649009899

Sheet3

Peter_SSs · Jun 12, 2020

It is not surprising that my earlier code does not work with that data - it is entirely different!

For those two sample rows, this works for me.

VBA Code:

Sub Rearrange_v2()
  Dim a As Variant, b As Variant
  Dim RX As Object, M As Object
  Dim OrdNum As String, FranchiseID As String
  Dim i As Long, k As Long

  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.Pattern = "(DS3\|.*?\|)([^\|]+?)(\|)([^\|]+)(\|)([^\|]+)(\|)([^\|]+)(\|)"
  With Sheets("Sheet2")
    a = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Value
  End With
  ReDim b(1 To UBound(a) * 100, 1 To 6)
  For i = 1 To UBound(a)
    FranchiseID = Trim(Split(Split(Split(a(i, 1), "Franchise ID")(1), vbLf)(0), "=")(1))
    OrdNum = Trim(Split(Split(a(i, 1), vbLf)(0), "=")(1))
    For Each M In RX.Execute(a(i, 1))
      k = k + 1
      b(k, 1) = FranchiseID
      b(k, 2) = OrdNum
      b(k, 3) = Val(Trim(M.SubMatches(7)))
      b(k, 4) = Trim(M.SubMatches(1))
      b(k, 5) = Trim(M.SubMatches(3))
      b(k, 6) = Trim(M.SubMatches(5))
    Next M
  Next i
  With Sheets("Sheet3").Range("A2").Resize(k, 7)
    .Rows(0).Value = Array("Date", "Franchise ID", "Order No", "Quantity", "Denomination", "From", "To")
    .Columns(1).Value = Date
    With .Offset(, 1).Resize(, 6)
      .Columns(5).Resize(, 2).NumberFormat = "@"
      .Value = b
    End With
    .EntireColumn.AutoFit
  End With
End Sub

Data Text to Column

decent_boy

Board Regular

Excel Facts

GraH

Well-known Member

Peter_SSs

MrExcel MVP, Moderator

GraH

Well-known Member

decent_boy

Board Regular

Peter_SSs

MrExcel MVP, Moderator

decent_boy

Board Regular

Peter_SSs

MrExcel MVP, Moderator

decent_boy

Board Regular

Peter_SSs

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

Data Text to Column

Board Regular

Excel Facts

Well-known Member

MrExcel MVP, Moderator

Well-known Member

Board Regular

MrExcel MVP, Moderator

Board Regular

MrExcel MVP, Moderator

Board Regular

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock