Split data

[Deepk]

Hi all,

I want a macro for changing the following data

Input:

AB2345 SD7890	AB XC
CB2345 GH6543	SD FG
ER2345 CV3455	GH MN
WX9876 RE3456	HJ KL

<colgroup><col width="64" span="2" style="width:48pt"> </colgroup><tbody>
</tbody>

Output:

AB2345	AB
SD7890	XC
CB2345	SD
GH6543	FG
ER2345	GH
CV3455	MN
WX9876	HJ
RE3456	KL

<colgroup><col width="64" span="2" style="width:48pt"> </colgroup><tbody>
</tbody>

Thanks in advance.

 

[mohadin]

Hi Mr Rick,
That is really interesting

 

[mohadin]

Hi
What about

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

 

[mohadin]

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"

 

[mohadin]

Unfortunately Mr. ricks code throw (#N/A) starting fro, row 54467 when the data in 60000 row!!!
any explanation please

 

[Peter_SSs]

Unfortunately Mr. ricks code throw (#N/A) starting fro, row 54467 when the data in 60000 row!!!
any explanation please

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.

 

[mohadin]

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

 

[Deepk]

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.

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

hi peter,

There is change in input data. Could you please refine the code.

BR11201 BR11201	CW4225687
EP2941323	SD104548215 SD104548215
MY20150086 MY361610 MY3621610 CT3621610	CX2955639
TT1436868 TTI643678 TTI6436782 TTI6436784 TTI6436788	ST2016011298

<colgroup><col span="2"></colgroup><tbody>
</tbody>

Many thanks in advance.

 

[Rick Rothstein]

BR11201 BR11201	CW4225687
EP2941323	SD104548215 SD104548215
MY20150086 MY361610 MY3621610 CT3621610	CX2955639
TT1436868 TTI643678 TTI6436782 TTI6436784 TTI6436788	ST2016011298

<colgroup><col span="2"></colgroup><tbody>
</tbody>

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?

 

[Deepk]

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?

Input:

BR11201 BR11201	CW4225687 MY361610
FV2941323	SD104548215
MY20150086 MY361610 MY3621610 CT3621610	CX2955639 CX29XXXX CX29GGHHGG CXIUYITTPIOU
TT1436868 TTI6436789 TTI6436782 TTI6436784 TTI6436788	ST2016011298 ST2016DDD DD2016011298 DD20SSSSS KKKK16011298

<tbody>
</tbody>

Output

BR11201	CW4225687
BR11201	MY361610
FV2941323	SD104548215
MY20150086	CX2955639
MY361610	CX29XXXX
MY3621610	CX29GGHHGG
CT3621610	CXIUYITTPIOU
TT1436868	ST2016011298
TTI6436789	ST2016DDD
TTI6436782	DD2016011298
TTI6436784	DD20SSSSS
TTI6436788	KKKK16011298

<tbody>
</tbody>

I am not able to insert a table in reply.

 

[Peter_SSs]

Try

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

I am not able to insert a table in reply.

While in the Reply window, click 'Go Advanced' and the table option should be available.