How to duplicate a cell based on number of adjacent row values

[ramzraja]

Hi All,

May i know how could i achieve below task :
I have a below excel with data as follows :

[TABLE="class: grid, width: 200, align: left"]
<tbody>[TR]
[TD]ID[/TD]
[TD]Resource[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]ABC[/TD]
[TD]Employee[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]XYZ[/TD]
[TD]Customer[/TD]
[TD]Agent[/TD]
[/TR]
</tbody>[/TABLE]






Depending up the number of resources assigned to the ID in the adjacent row, the ID should get duplicated N times as below

[TABLE="class: grid, width: 200, align: left"]
<tbody>[TR]
[TD]ID[/TD]
[TD]Resource[/TD]
[/TR]
[TR]
[TD]ABC[/TD]
[TD]Employee[/TD]
[/TR]
[TR]
[TD]XYZ[/TD]
[TD]Customer[/TD]
[/TR]
[TR]
[TD]XYZ[/TD]
[TD]Agent[/TD]
[/TR]
</tbody>[/TABLE]







Any suggestion to resolve it would be appreciated

Thanks,
RZ

 

[hiker95]

ramzraja,

Welcome to the MrExcel forum.

I think you will need a macro to do what you want.

Here is a macro solution for you to consider, that will run in the active worksheet, that uses two arrays in memory, and, will adjust to the number of raw data rows, and, columns.

The results will be written, beginning in the third column, after the last used column of your raw data.

Sample raw data, and, results:

Excel 2007
	A	B	C	D	E	F	G
1	ID	Resource				ID	Resource
2	ABC	Employee				ABC	Employee
3	XYZ	Customer	Agent			XYZ	Customer
4						XYZ	Agent
5
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).

Sub ReorgData()
' hiker95, 03/12/2016, ME927563
Dim a As Variant, i As Long, c As Long, n As Long
Dim o As Variant, j As Long
Application.ScreenUpdating = False
With ActiveSheet
  a = .Cells(1).CurrentRegion
  n = Application.CountA(.Cells(1).CurrentRegion)
  ReDim o(1 To n, 1 To 2)
  For i = LBound(a, 1) To UBound(a, 2)
    For c = 2 To UBound(a, 2)
      If Not a(i, c) = vbEmpty Then
        j = j + 1: o(j, 1) = a(i, 1): o(j, 2) = a(i, c)
      End If
    Next c
  Next i
  .Cells(1, UBound(a, 2) + 3).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns.AutoFit
End With
Application.ScreenUpdating = True
End Sub

How To Install Macros:

If you are new to macros, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. To use the macro, go back to the worksheet with your data on it and press ALT+F8, select the macro name (MakeInchesFractionsToDecimalNumber) from the list that appears and click the Run button. The macro will execute and perform the action(s) you asked for. If you will need to do this again in this same workbook, and if you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.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.

 

[ramzraja]

Hi Hiker95,

Thank you for the prompt reply.

I tried using the above macro but it only works for the first 3 rows as below :

Excel Data :

[TABLE="width: 235"]
<colgroup><col><col><col></colgroup><tbody>[TR]
[TD][TABLE="width: 235"]
<colgroup><col><col><col></colgroup><tbody>[TR]
[TD]LoginID[/TD]
[TD]Resource[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]bouza497[/TD]
[TD]Agent[/TD]
[TD]End-User[/TD]
[/TR]
[TR]
[TD]hemat499[/TD]
[TD]Agent[/TD]
[TD]End-User[/TD]
[/TR]
[TR]
[TD]rahmo499[/TD]
[TD]Agent[/TD]
[TD]End-User[/TD]
[/TR]
[TR]
[TD]fouw498[/TD]
[TD]Agent[/TD]
[TD]End-User[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Output after running the macro :

[TABLE="width: 132"]
<colgroup><col><col></colgroup><tbody>[TR]
[TD]LoginID[/TD]
[TD]Resource[/TD]
[/TR]
[TR]
[TD]bouza497[/TD]
[TD]Agent[/TD]
[/TR]
[TR]
[TD]bouza497[/TD]
[TD]End-User[/TD]
[/TR]
[TR]
[TD]hemat499[/TD]
[TD]Agent[/TD]
[/TR]
[TR]
[TD]hemat499[/TD]
[TD]End-User[/TD]
[/TR]
[TR]
[TD]rahmo499[/TD]
[TD]Agent[/TD]
[/TR]
[TR]
[TD]rahmo499[/TD]
[TD]End-User[/TD]
[/TR]
</tbody>[/TABLE]

I have around 3000+user list in my workbook. May i know could i run the macro for all the users ?

Thank you.
RZ

 

[hiker95]

ramzraja,

I found my code error.

Here is a new macro for you to consider, that will run in the active worksheet, that uses two arrays in memory, and, will adjust to the number of raw data rows, and, columns.

The results will be written, beginning in the third column, after the last used column of your raw data.


Sample raw data, and, results:

Excel 2007
	A	B	C	D	E	F	G
1	LoginID	Resource				LoginID	Resource
2	bouza497	Agent	End-User			bouza497	Agent
3	hemat499	Agent	End-User			bouza497	End-User
4	rahmo499	Agent	End-User			hemat499	Agent
5	fouw498	Agent	End-User			hemat499	End-User
6						rahmo499	Agent
7						rahmo499	End-User
8						fouw498	Agent
9						fouw498	End-User
10
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).

Sub ReorgData_V2()
' hiker95, 03/14/2016, ME927563
Dim a As Variant, i As Long, c As Long, n As Long
Dim o As Variant, j As Long
Application.ScreenUpdating = False
With ActiveSheet
  a = .Cells(1).CurrentRegion
  n = Application.CountA(.Cells(1).CurrentRegion)
  ReDim o(1 To n, 1 To 2)
  For i = LBound(a, 1) To UBound(a, 1)
    For c = 2 To UBound(a, 2)
      If Not a(i, c) = vbEmpty Then
        j = j + 1: o(j, 1) = a(i, 1): o(j, 2) = a(i, c)
      End If
    Next c
  Next i
  .Cells(1, UBound(a, 2) + 3).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns.AutoFit
End With
Application.ScreenUpdating = True
End Sub

Then run the ReorgData_V2 macro.