Data Text to Column

decent_boy

Board Regular
Joined
Dec 5, 2014
Messages
130
Office Version
  1. 2016
Platform
  1. Windows
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
1Order No = A25/CP/0123/00333
2Order Amount = 12351
3SH_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
12Order No = A32/CP/0152/00352
13Order Amount = 726
14SH_ID = TA9
15
16-------------------------------------------------------------------------------------------------------------------------------------------------------------
17| SP |Type |Denomination |From |To | Quantity| |
18-------------------------------------------------------------------------------------------------------------------------------------------------------------
19|DS2|EU |ITEM-232 |0101250300225200 |0101250300225299 | 100|JHON |
20
21Order No = A33/CP/0192/00395
22Order Amount = 8252
23SH_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


ABCDEFG
1DateSH_IDOrder NoQuantityDenominationFrom To
220-May-20TA5 A25/CP/0123/00333100ITEM-23201012503002251000101250300225199
320-May-20TA5 A25/CP/0123/00333200ITEM-32406005286002100000600528600210199
420-May-20TA5 A25/CP/0123/0033330ITEM-5240005084901091890 0005084901091919
520-May-20TA9A32/CP/0152/00352100ITEM-23201012503002252000101250300225299
620-May-20TA2A33/CP/0192/00395100ITEM-23201012503002253000101250300225399
720-May-20TA2A33/CP/0192/00395200ITEM-32406005286002102000600528600210399


Excel tables to the web >> Excel Jeanie HTML 4
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
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
1590248693097.png


EDIT: just noticed I don't have the date column, but that does not come from the data source does it?
 
Last edited:
Upvote 0
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.

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
ABCDEFGHI
1Order No = A25/CP/0123/00333DateSH_IDOrder NoQuantityDenominationFromTo
2Order Amount = 1235124-May-20TA5A25/CP/0123/00333100ITEM-232 0101250300225100 0101250300225199
3SH_ID = TA524-May-20TA5A25/CP/0123/00333200ITEM-324 0600528600210000 0600528600210199
424-May-20TA5A25/CP/0123/0033330ITEM-524 0005084901091890 0005084901091919
5-------------------------------------------------------------------------------------------------------------------------------------------------------------24-May-20TA9A32/CP/0152/00352100ITEM-232 0101250300225200 0101250300225299
6| SP |Type |Denomination |From |To | Quantity| |24-May-20TA2A33/CP/0192/00395100ITEM-232 0101250300225300 0101250300225399
7-------------------------------------------------------------------------------------------------------------------------------------------------------------24-May-20TA2A33/CP/0192/00395200ITEM-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
12Order No = A32/CP/0152/00352
13Order Amount = 726
14SH_ID = TA9
15
16-------------------------------------------------------------------------------------------------------------------------------------------------------------
17| SP |Type |Denomination |From |To | Quantity| |
18-------------------------------------------------------------------------------------------------------------------------------------------------------------
19|DS2|EU |ITEM-232 |0101250300225200 |0101250300225299 | 100|JHON |
20
21Order No = A33/CP/0192/00395
22Order Amount = 8252
23SH_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
 
Upvote 0
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 (y)(y) . 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.
 
Upvote 0
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
ABCDEFGHI
1Order No = A25/CP/0123/00333DateSH_IDOrder NoQuantityDenominationFromTo
2Order Amount = 1235124-May-20TA5A25/CP/0123/00333100ITEM-232 0101250300225100 0101250300225199
3SH_ID = TA524-May-20TA5A25/CP/0123/00333200ITEM-324 0600528600210000 0600528600210199
424-May-20TA5A25/CP/0123/0033330ITEM-524 0005084901091890 0005084901091919
5-------------------------------------------------------------------------------------------------------------------------------------------------------------24-May-20TA9A32/CP/0152/00352100ITEM-232 0101250300225200 0101250300225299
6| SP |Type |Denomination |From |To | Quantity| |24-May-20TA2A33/CP/0192/00395100ITEM-232 0101250300225300 0101250300225399
7-------------------------------------------------------------------------------------------------------------------------------------------------------------24-May-20TA2A33/CP/0192/00395200ITEM-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
12Order No = A32/CP/0152/00352
13Order Amount = 726
14SH_ID = TA9
15
16-------------------------------------------------------------------------------------------------------------------------------------------------------------
17| SP |Type |Denomination |From |To | Quantity| |
18-------------------------------------------------------------------------------------------------------------------------------------------------------------
19|DS2|EU |ITEM-232 |0101250300225200 |0101250300225299 | 100|JHON |
20
21Order No = A33/CP/0192/00395
22Order Amount = 8252
23SH_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
 
Upvote 0
You're welcome. Thanks for the follow-up. (y)

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
 
Upvote 0
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
 
Upvote 0
Please find some new relevant sample data 2 rows

Extract Emails.xlsm
A
1Order 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 . .
2Order 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
ABCDEFG
1DateFranchise IDOrder NoQuantityDenominationFromTo
212-Jun-20YT500A25/CP/0123/003331200ITEM-23200090005673704000009000567371599
312-Jun-20YT500A25/CP/0123/00333100ITEM-52610090006490095001009000649009599
412-Jun-20TA9A33/CP/0192/00395300ITEM-5260009000559300800 0009000559301099
512-Jun-20TA9A33/CP/0192/003952400ITEM-10000090005673716000009000567373999
612-Jun-20TA9A33/CP/0192/00395300ITEM-40010090006490096001009000649009899
Sheet3
 
Upvote 0
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
 
Upvote 0

Similar threads

Forum statistics

Threads
1,213,562
Messages
6,114,322
Members
448,564
Latest member
ED38

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