Data Text to Column

[decent_boy]

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

 

[Peter_SSs]

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.

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

 

[decent_boy]

Thanks for your reply
I have not checked it yet but my question is that if following line next row is DS4 or DS5 or DS6 then won't it work ?
RX.Pattern = "(DS3\|.*?\|)([^\|]+?)(\|)([^\|]+)(\|)([^\|]+)(\|)([^\|]+)(\|)"

 

[decent_boy]

I have checked now and when I changed DS3 into DS4, code has not copied data of DS4
I would like to say that this line can be different
Maybe be start with DS or UF or QT