Splitting of data into multiple row as illustrated below

[NEELKUMAR_SOLANKI]

Data which i am having is as follows:

[TABLE="width: 144"]
<colgroup><col><col></colgroup><tbody></tbody>[/TABLE]
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD="align: center"]Name[/TD]
[TD="align: center"]Data[/TD]
[/TR]
[TR]
[TD]abc[/TD]
[TD]2,3,4,5[/TD]
[/TR]
[TR]
[TD]pqr[/TD]
[TD]3,4,5,6,7,8,9[/TD]
[/TR]
[TR]
[TD]xyz[/TD]
[TD]5,6,7,8,9[/TD]
[/TR]
</tbody>[/TABLE]



Required Result Should look like following:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD="align: center"]Name[/TD]
[TD="align: center"]Data[/TD]
[/TR]
[TR]
[TD]abc[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]abc[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]abc[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]abc[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]pqr[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]pqr[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]pqr[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]pqr[/TD]
[TD]6[/TD]
[/TR]
[TR]
[TD]pqr[/TD]
[TD]7[/TD]
[/TR]
[TR]
[TD]pqr[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]pqr[/TD]
[TD]9[/TD]
[/TR]
[TR]
[TD]xyz[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]xyz[/TD]
[TD]6[/TD]
[/TR]
[TR]
[TD]xyz[/TD]
[TD]7[/TD]
[/TR]
[TR]
[TD]xyz[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]xyz[/TD]
[TD]9[/TD]
[/TR]
</tbody>[/TABLE]


How can i Create Relevant Macro to have this Result ?

 

[Ombir]

Neel, Assuming you have data in Sheet1 and Sheet2 is blank, hope this helps you :

Sub neel()
Dim i As Long, j As Long, lr As Long, nr As Long
Dim ws1 As Worksheet, ws2 As Worksheet, ar As Variant

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
lr = ws1.Cells(Rows.Count, 1).End(xlUp).Row

Application.ScreenUpdating = False

ws2.Cells(1, 1) = "Name": ws2.Cells(1, 2) = "Data"

nr = 2
For i = 2 To lr
    Key = ws1.Cells(i, 1)
    sp = Split(ws1.Cells(i, 2), ",")
        For j = LBound(sp) To UBound(sp)
            ws2.Cells(nr, 1) = Key
            ws2.Cells(nr, 2) = sp(j)
            nr = nr + 1
        Next
Next
Application.ScreenUpdating = True
ws2.UsedRange.Columns.AutoFit
End Sub

 

[hiker95]

Neelkumar_solanki,

Welcome to the MrExcel forum.

1. What version of Excel, and, Windows are you using?

2. Are you using a PC or a Mac?

Here is a macro solution for you to consider that uses a Function, and, two arrays in memory, that is based on your two screenshots.

You can change the raw data worksheet name in the macro.

Sample raw data in worksheet Sheet1:

Excel 2007
	A	B
1	Name	Data
2	abc	2,3,4,5
3	pqr	3,4,5,6,7,8,9
4	xyz	5,6,7,8,9
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sheet1

And, after the macro, in worksheet Sheet1:

Excel 2007
	A	B
1	Name	Data
2	abc	2
3	abc	3
4	abc	4
5	abc	5
6	pqr	3
7	pqr	4
8	pqr	5
9	pqr	6
10	pqr	7
11	pqr	8
12	pqr	9
13	xyz	5
14	xyz	6
15	xyz	7
16	xyz	8
17	xyz	9
18
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below macro code, and, Function
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub c()
' hiker95, 01/16/2016, ME914758
Dim a As Variant, i As Long
Dim o As Variant, j As Long
Dim s, k As Long
Dim lr As Long, n As Long, rng As Range
Application.ScreenUpdating = False
With Sheets("Sheet1")   '<-- you can change the sheet name here
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  a = .Range("A1:B" & lr).Value
  Set rng = .Range("B2:B" & lr)
  n = CountChar(rng, ",") + (lr - 1)
  ReDim o(1 To n, 1 To 2)
  For i = 2 To lr
    If InStr(a(i, 2), ",") Then
      s = Split(a(i, 2), ",")
      For k = LBound(s) To UBound(s)
        j = j + 1: o(j, 1) = a(i, 1): o(j, 2) = s(k)
      Next k
    End If
  Next i
  .Range("A2").Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns(1).Resize(, 2).AutoFit
End With
Application.ScreenUpdating = True
End Sub
Function CountChar(rng As Range, TextToFind As String) As Long
'http://www.vbaexpress.com/kb/getarticle.php?kb_id=235
'Function purpose:  To count number of instances of a string of
' characters in a range
Dim cl As Range, x As Integer
For Each cl In rng
  For x = 1 To Len(cl)
    If Mid(cl, x, Len(TextToFind)) = TextToFind Then
      CountChar = CountChar + 1
    End If
  Next x
Next cl
End Function

Before you use the macro, and, function, with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the ReorgData macro.

If you need the results written somewhere else, then let me know, and, I will adjust the macro.