Split data

D

Deepk

Board Regular
Joined
Mar 21, 2018
Messages
105
Office Version
  1. 2016
Platform
  1. Windows
Hi all,

I want a macro for changing the following data

Input:
[TABLE="width: 128"]
<colgroup><col width="64" span="2" style="width:48pt"> </colgroup><tbody>[TR]
[TD="class: xl65, width: 64"]AB2345
SD7890[/TD]
[TD="class: xl65, width: 64"]AB
XC[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 64"]CB2345
GH6543[/TD]
[TD="class: xl65, width: 64"]SD
FG[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 64"]ER2345
CV3455[/TD]
[TD="class: xl65, width: 64"]GH
MN[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 64"]WX9876
RE3456[/TD]
[TD="class: xl65, width: 64"]HJ
KL[/TD]
[/TR]
</tbody>[/TABLE]

Output:

[TABLE="width: 128"]
<colgroup><col width="64" span="2" style="width:48pt"> </colgroup><tbody>[TR]
[TD="class: xl65, width: 64"]AB2345[/TD]
[TD="class: xl65, width: 64"]AB[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 64"]SD7890[/TD]
[TD="class: xl65, width: 64"]XC[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 64"]CB2345[/TD]
[TD="class: xl65, width: 64"]SD[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 64"]GH6543[/TD]
[TD="class: xl65, width: 64"]FG[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 64"]ER2345[/TD]
[TD="class: xl65, width: 64"]GH[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 64"]CV3455[/TD]
[TD="class: xl65, width: 64"]MN[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 64"]WX9876[/TD]
[TD="class: xl65, width: 64"]HJ[/TD]
[/TR]
[TR]
[TD="class: xl66, width: 64"]RE3456[/TD]
[TD="class: xl66, width: 64"]KL[/TD]
[/TR]
</tbody>[/TABLE]

Thanks in advance.
 
Last edited:
Sort by date Sort by votes
Hi Mr Rick,
That is really interesting
 
Last edited:
Upvote 0

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Hi
What about
Code: 
Sub ttt()
    Dim Flag As Boolean
    Dim sm As Object, a
    r = Cells(Rows.Count, "A").End(xlUp).Row
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "([A-Z])\w+"
        Flag = True
        ReDim a(1 To 2, 1 To r)
        k = 1: l = 1
        For Each cel In Range("a1:b" & r)
            If Not Flag Then k = k - 1
            Set m = .Execute(cel)
            a(l, k) = m(0)
            a(l, k + 1) = m(1)
            k = k + 1: l = l + 1
            If l > 2 Then l = 1
            If Not Flag Then k = k + 1
            If k > r Then Exit For
            Flag = Not Flag
        Next
    End With
    a = Application.Transpose(a)
    [c1].Resize(UBound(a, 1), 2) = a
End Sub
 
Upvote 0
And this the result "on seconds" test for 20000 rows

0.19922 Mr. Peter
0.23047 Mr. RICK
0.23438 mine


2.19922 mine ( the first I posted)"lol"
 
Upvote 0
Unfortunately Mr. ricks code throw (#N/A) starting fro, row 54467 when the data in 60000 row!!!
any explanation please
 
Upvote 0
mohadin said:
Unfortunately Mr. ricks code throw (#N/A) starting fro, row 54467 when the data in 60000 row!!!
any explanation please
Click to expand...
There is a known limitation with Application.Transpose for large data & Rick knows about it, but here the OP said they only have a few thousand rows so that should not be an issue.
 
Upvote 0
Well thank you Mr. Peter
I just knew about this limitation you are talking about
BTW my second code is doing the same as the other one but in different row if you like
 
Last edited:
Upvote 0
Peter_SSs said:
OK thanks. That is actually pretty small for vba so the fact that this is roughly 30 times faster probably wouldn't be noticeable. :)
If there was a lot more data this would begin to show up as noticeably faster.

Code: 
Sub Split_Data()
  Dim a As Variant, b As Variant, c As Variant
  Dim i As Long
  
  a = Range("A1", Range("B" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a) * 2, 1 To 2)
  For i = 1 To UBound(a)
    c = Split(a(i, 1), Chr(10))
    b(i * 2 - 1, 1) = c(0)
    b(i * 2, 1) = c(1)
    c = Split(a(i, 2), Chr(10))
    b(i * 2 - 1, 2) = c(0)
    b(i * 2, 2) = c(1)
  Next
  Range("D1:E1").Resize(UBound(b)).Value = b
End Sub
Click to expand...

hi peter,

There is change in input data. Could you please refine the code.
[TABLE="width: 234"]
<colgroup><col span="2"></colgroup><tbody>[TR]
[TD]BR11201
BR11201[/TD]
[TD]CW4225687[/TD]
[/TR]
[TR]
[TD]EP2941323
[/TD]
[TD]SD104548215

SD104548215[/TD]
[/TR]
[TR]
[TD]MY20150086
MY361610
MY3621610
CT3621610[/TD]
[TD]CX2955639[/TD]
[/TR]
[TR]
[TD]TT1436868

TTI643678
TTI6436782
TTI6436784
TTI6436788[/TD]
[TD]ST2016011298[/TD]
[/TR]
</tbody>[/TABLE]
Many thanks in advance.
 
Last edited:
Upvote 0
Deepk said:
[TABLE="width: 234"]
<colgroup><col span="2"></colgroup><tbody>[TR]
[TD]BR11201
BR11201[/TD]
[TD]CW4225687[/TD]
[/TR]
[TR]
[TD]EP2941323
[/TD]
[TD]SD104548215

SD104548215[/TD]
[/TR]
[TR]
[TD]MY20150086
MY361610
MY3621610
CT3621610[/TD]
[TD]CX2955639[/TD]
[/TR]
[TR]
[TD]TT1436868

TTI643678
TTI6436782
TTI6436784
TTI6436788[/TD]
[TD]ST2016011298[/TD]
[/TR]
</tbody>[/TABLE]
Click to expand...
The layout of your data is virtually unreadable. Could you put borders around the cell data like you did in the first message? Also, could you show us the expected output for this data like you did in the first message?
 
Upvote 0
Rick Rothstein said:
The layout of your data is virtually unreadable. Could you put borders around the cell data like you did in the first message? Also, could you show us the expected output for this data like you did in the first message?
Click to expand...

Input:

[TABLE="width: 379"]
<tbody>[TR]
[TD]BR11201
BR11201[/TD]
[TD]CW4225687
MY361610[/TD]
[/TR]
[TR]
[TD]FV2941323[/TD]
[TD]SD104548215[/TD]
[/TR]
[TR]
[TD]MY20150086
MY361610
MY3621610
CT3621610[/TD]
[TD]CX2955639
CX29XXXX
CX29GGHHGG
CXIUYITTPIOU[/TD]
[/TR]
[TR]
[TD]TT1436868
TTI6436789
TTI6436782
TTI6436784
TTI6436788[/TD]
[TD]ST2016011298
ST2016DDD
DD2016011298
DD20SSSSS
KKKK16011298[/TD]
[/TR]
</tbody>[/TABLE]


Output

[TABLE="width: 200"]
<tbody>[TR]
[TD]BR11201[/TD]
[TD]CW4225687[/TD]
[/TR]
[TR]
[TD]BR11201[/TD]
[TD]MY361610[/TD]
[/TR]
[TR]
[TD]FV2941323[/TD]
[TD]SD104548215[/TD]
[/TR]
[TR]
[TD]MY20150086[/TD]
[TD]CX2955639[/TD]
[/TR]
[TR]
[TD]MY361610[/TD]
[TD]CX29XXXX[/TD]
[/TR]
[TR]
[TD]MY3621610[/TD]
[TD]CX29GGHHGG[/TD]
[/TR]
[TR]
[TD]CT3621610[/TD]
[TD]CXIUYITTPIOU[/TD]
[/TR]
[TR]
[TD]TT1436868[/TD]
[TD]ST2016011298[/TD]
[/TR]
[TR]
[TD]TTI6436789[/TD]
[TD]ST2016DDD[/TD]
[/TR]
[TR]
[TD]TTI6436782[/TD]
[TD]DD2016011298[/TD]
[/TR]
[TR]
[TD]TTI6436784[/TD]
[TD]DD20SSSSS[/TD]
[/TR]
[TR]
[TD]TTI6436788[/TD]
[TD]KKKK16011298[/TD]
[/TR]
</tbody>[/TABLE]

I am not able to insert a table in reply. :(
 
Last edited:
Upvote 0
Try
Code: 
Sub Split_Data_v2()
  Dim a As Variant, b As Variant, c As Variant, d As Variant
  Dim i As Long, j As Long, k As Long
    
  a = Range("A1", Range("B" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To Rows.Count, 1 To 2)
  For i = 1 To UBound(a)
    c = Split(a(i, 1), Chr(10))
    d = Split(a(i, 2), Chr(10))
    For j = 0 To UBound(c)
      k = k + 1
      b(k, 1) = c(j): b(k, 2) = d(j)
    Next j
  Next
  Range("D1:E1").Resize(k).Value = b
End Sub



Deepk said:
I am not able to insert a table in reply. :(
Click to expand...
While in the Reply window, click 'Go Advanced' and the table option should be available.
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question Question
Macro Help - Transposing Some Data from Columns to Rows, Accounting for Duplicate Data
Replies
1
Views
116
Kaper
Kaper
K
  • Question Question
Excel VBA - Element not found error
Replies
0
Views
137
kyk8898
K
D
  • Solved
VBA Function to Paste Table into Outlook Email Resulting in HTML language in Email
Replies
8
Views
571
smozgur
smozgur
E
  • Solved
Comparing two comma-delimited lists and getting unique values
Replies
7
Views
1K
Fluff
Fluff
A
  • Solved
delete one of values colums by split data into two sheets
2
Replies
14
Views
528
Alaa mg
A

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

Share this page

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