Transforming table, column manipulation, creating more lines that contain specific data

[baldwinp]

Hi I was hoping someone could help me come up with a formula or macro that will take data that looks like the top table and turn it into the bottom one. Thanks in advance.

Name</SPAN>	Number</SPAN>	Country</SPAN>	Color 1</SPAN>	Percent</SPAN>	Color 2</SPAN>	Percent</SPAN>	Color 3</SPAN>	Percent</SPAN>	Letter Code</SPAN>
James</SPAN>	4652</SPAN>	US</SPAN>	Blue</SPAN>	0.7</SPAN>	Pink</SPAN>	0.2</SPAN>	Orange</SPAN>	0.1</SPAN>	aaa</SPAN>
Marry</SPAN>	1861</SPAN>	Brazil</SPAN>	Green</SPAN>	0.3</SPAN>	Blue</SPAN>	0.7</SPAN>			bbb</SPAN>
George</SPAN>	1863</SPAN>	Argentina </SPAN>	Yellow</SPAN>	0.5</SPAN>	Green</SPAN>	0.25</SPAN>	Blue</SPAN>	0.25</SPAN>	ccc</SPAN>
John</SPAN>	1564</SPAN>	Germany</SPAN>	Yellow</SPAN>	0.5</SPAN>	Blue</SPAN>	0.5</SPAN>			def</SPAN>
Tim</SPAN>	1562</SPAN>	Egypt</SPAN>	Pink</SPAN>	1</SPAN>					ftr</SPAN>
Cathy</SPAN>	4653</SPAN>	China</SPAN>	Yellow</SPAN>	0.6</SPAN>	Blue</SPAN>	0.4</SPAN>			sad</SPAN>
Tim</SPAN>	7954</SPAN>	Turkey</SPAN>	Green</SPAN>	1</SPAN>					asd</SPAN>
James</SPAN>	4787</SPAN>	France</SPAN>	Pink</SPAN>	0.75</SPAN>	Green</SPAN>	0.15</SPAN>	Yellow</SPAN>	0.1</SPAN>	ghf</SPAN>
Steve</SPAN>	161667</SPAN>	UK</SPAN>	Pink</SPAN>	0.8</SPAN>	Blue</SPAN>	0.2</SPAN>			dhd</SPAN>
Name</SPAN>	Number</SPAN>	Country</SPAN>	Color</SPAN>	Percent</SPAN>	Letter Code</SPAN>
James</SPAN>	4652</SPAN>	US</SPAN>	Blue</SPAN>	0.7</SPAN>	aaa</SPAN>
Marry</SPAN>	1861</SPAN>	Brazil</SPAN>	Green</SPAN>	0.3</SPAN>	bbb</SPAN>
George</SPAN>	1863</SPAN>	Argentina </SPAN>	Yellow</SPAN>	0.5</SPAN>	ccc</SPAN>
John</SPAN>	1564</SPAN>	Germany</SPAN>	Yellow</SPAN>	0.5</SPAN>	def</SPAN>
Tim</SPAN>	1562</SPAN>	Egypt</SPAN>	Pink</SPAN>	1</SPAN>	ftr</SPAN>
Cathy</SPAN>	4653</SPAN>	China</SPAN>	Yellow</SPAN>	0.6</SPAN>	sad</SPAN>
Tim</SPAN>	7954</SPAN>	Turkey</SPAN>	Green</SPAN>	1</SPAN>	asd</SPAN>
James</SPAN>	4787</SPAN>	France</SPAN>	Pink</SPAN>	0.75</SPAN>	ghf</SPAN>
Steve</SPAN>	161667</SPAN>	UK</SPAN>	Pink</SPAN>	0.8</SPAN>	dhd</SPAN>
James</SPAN>	4652</SPAN>	US</SPAN>	Pink</SPAN>	0.2</SPAN>	aaa</SPAN>
Marry</SPAN>	1861</SPAN>	Brazil</SPAN>	Blue</SPAN>	0.7</SPAN>	bbb</SPAN>
George</SPAN>	1863</SPAN>	Argentina </SPAN>	Green</SPAN>	0.25</SPAN>	ccc</SPAN>
John</SPAN>	1564</SPAN>	Germany</SPAN>	Blue</SPAN>	0.5</SPAN>	def</SPAN>
Cathy</SPAN>	4653</SPAN>	China</SPAN>	Blue</SPAN>	0.4</SPAN>	sad</SPAN>
James</SPAN>	4787</SPAN>	France</SPAN>	Green</SPAN>	0.15</SPAN>	ghf</SPAN>
Steve</SPAN>	161667</SPAN>	UK</SPAN>	Blue</SPAN>	0.2</SPAN>	dhd</SPAN>
James</SPAN>	4652</SPAN>	US</SPAN>	Orange</SPAN>	0.1</SPAN>	aaa</SPAN>
George</SPAN>	1863</SPAN>	Argentina </SPAN>	Blue</SPAN>	0.25</SPAN>	ccc</SPAN>
James</SPAN>	4787</SPAN>	France</SPAN>	Yellow</SPAN>	0.1</SPAN>	ghf</SPAN>

<TBODY>
</TBODY><COLGROUP><COL><COL><COL><COL span=2><COL span=2><COL span=2><COL></COLGROUP>

 

[hiker95]

baldwinp,

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

2. Are you using a PC or a Mac?


The following macro using two arrays in memory should adjust for a varying number or rows, and, columns.

Sample raw data in the active worksheet:

Excel 2007
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R
1	Name	Number	Country	Color 1	Percent	Color 2	Percent	Color 3	Percent	Letter Code
2	James	4652	US	Blue	0.7	Pink	0.2	Orange	0.1	aaa
3	Marry	1861	Brazil	Green	0.3	Blue	0.7			bbb
4	George	1863	Argentina	Yellow	0.5	Green	0.25	Blue	0.25	ccc
5	John	1564	Germany	Yellow	0.5	Blue	0.5			def
6	Tim	1562	Egypt	Pink	1					ftr
7	Cathy	4653	China	Yellow	0.6	Blue	0.4			sad
8	Tim	7954	Turkey	Green	1					asd
9	James	4787	France	Pink	0.75	Green	0.15	Yellow	0.1	ghf
10	Steve	161667	UK	Pink	0.8	Blue	0.2			dhd
11
12
13
14
15
16
17
18
19
20
21
Sheet1

After the macro in the same worksheet beginning in the third column after the last used column:

Excel 2007
	M	N	O	P	Q	R
1	Name	Number	Country	Color	Percent	Letter Code
2	James	4652	US	Blue	0.7	aaa
3	Marry	1861	Brazil	Green	0.3	bbb
4	George	1863	Argentina	Yellow	0.5	ccc
5	John	1564	Germany	Yellow	0.5	def
6	Tim	1562	Egypt	Pink	1	ftr
7	Cathy	4653	China	Yellow	0.6	sad
8	Tim	7954	Turkey	Green	1	asd
9	James	4787	France	Pink	0.75	ghf
10	Steve	161667	UK	Pink	0.8	dhd
11	James	4652	US	Pink	0.2	aaa
12	Marry	1861	Brazil	Blue	0.7	bbb
13	George	1863	Argentina	Green	0.25	ccc
14	John	1564	Germany	Blue	0.5	def
15	Cathy	4653	China	Blue	0.4	sad
16	James	4787	France	Green	0.15	ghf
17	Steve	161667	UK	Blue	0.2	dhd
18	James	4652	US	Orange	0.1	aaa
19	George	1863	Argentina	Blue	0.25	ccc
20	James	4787	France	Yellow	0.1	ghf
21
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 code
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 ReorgData()
' hiker95, 10/21/2014, ME813049
Dim a As Variant, o As Variant
Dim i As Long, j As Long
Dim lr As Long, lc As Long, luc As Long, c As Long, n As Long, mr As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(1, 1).End(xlToRight).Column
a = Range(Cells(1, 1), Cells(lr, lc))
luc = Cells(1, Columns.Count).End(xlToLeft).Column
If luc > lc Then Columns(lc + 3).Resize(, luc - (lc + 2)).ClearContents
n = Application.CountIf(Rows(1), "Color*")
For c = 4 To lc - 2 Step 2
  mr = mr + Application.CountA(Range(Cells(2, c), Cells(lr, c)))
Next c
ReDim o(1 To mr, 1 To 6)
With Cells(1, lc + 3).Resize(, 6)
  .Value = Array("Name", "Number", "Country", "Color", "Percent", "Letter Code")
  .Font.Bold = True
End With
For c = 4 To lc - 2 Step 2
  For i = 2 To lr Step 1
    If Cells(i, c) <> "" Then
      j = j + 1
      o(j, 1) = a(i, 1)
      o(j, 2) = a(i, 2)
      o(j, 3) = a(i, 3)
      o(j, 4) = a(i, c)
      o(j, 5) = a(i, c + 1)
      o(j, 6) = a(i, lc)
    End If
  Next i
Next c
Cells(2, lc + 3).Resize(mr, 6).Value = o
Columns(lc + 3).Resize(, 6).AutoFit
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ReorgData macro.