Rearrange Source Table

[MrSamExcel]

I have a table that looks like this:
Excel 2013 64 bit

	A​	B​	C​	D​	E​	F​
1​	Name	Div​	Int​	Down​	Purch​	Tax​
2​	A	X​		X​		X​
3​	B		X​
4​	C	X​		X​

<tbody>
</tbody>

Sheet: Sheet1

<tbody>
</tbody>

I need it to look like this:
Excel 2013 64 bit

	I​	J​
1​	Name	OutComeId
2​	A	1​
3​	A	3​
4​	A	5​
5​	B	2​
6​	C	1​
7​	C	3​

<tbody>
</tbody>

Sheet: Sheet1

<tbody>
</tbody>

and the "OutCome" key is as follows:
Excel 2013 64 bit

	M​	N​
1​	OutComeId	Description
2​	1	Div
3​	2	Int
4​	3	Down
5​	4	Purch
6​	5	Tax

<tbody>
</tbody>

Sheet: Sheet1

<tbody>
</tbody>

Any thoughts? Thanks.

 

[Max1616]

Give this a shot:

Option Explicit

Sub MrSamExcel()
Dim lrow As Long
Dim lclm As Integer
Dim ws As Worksheet
Dim Nws As Worksheet
Dim i As Long
Dim i2 As Integer
Dim Nlrow As Long

Set ws = ActiveSheet

lrow = Cells(Rows.Count, 1).End(xlUp).Row
lclm = Cells(1, Columns.Count).End(xlToLeft).Column

Set Nws = Sheets.Add
Nws.Name = "Results"

Nws.Cells(1, 1) = "Name"
Nws.Cells(1, 2) = "OutComeId"
Nlrow = 2

For i = 2 To lrow
    For i2 = 2 To lclm
        If ws.Cells(i, i2) <> "" Then
            Nws.Cells(Nlrow, 1) = ws.Cells(i, 1)
            Nws.Cells(Nlrow, 2) = i2 - 1
            Nlrow = Nws.Cells(Rows.Count, 1).End(xlUp).Row + 1
        End If
    Next i2
Next i
    
Nws.Cells(1, 5) = "OutComeId"
Nws.Cells(1, 6) = "Description"

Nws.Cells(2, 5) = 1
Nws.Cells(3, 5) = 2
Nws.Cells(4, 5) = 3
Nws.Cells(5, 5) = 4
Nws.Cells(6, 5) = 5
    
Nws.Cells(2, 6) = "Div"
Nws.Cells(3, 6) = "Int"
Nws.Cells(4, 6) = "Down"
Nws.Cells(5, 6) = "Purch"
Nws.Cells(6, 6) = "Tax"
    
    
End Sub

sincerely,
Max

 

[hiker95]

MrSamExcel,

Here is a macro solution for you to consider.

Sample raw data:

Excel 2007
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Name	Div	Int	Down	Purch	Tax			Name	OutComeId			OutComeId	Description
2	A	X		X		X							1	Div
3	B		X										2	Int
4	C	X		X									3	Down
5													4	Purch
6													5	Tax
7
8
Sheet1

And, after the macro:

Excel 2007
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Name	Div	Int	Down	Purch	Tax			Name	OutComeId			OutComeId	Description
2	A	X		X		X			A	1			1	Div
3	B		X						A	3			2	Int
4	C	X		X					A	5			3	Down
5									B	2			4	Purch
6									C	1			5	Tax
7									C	3
8
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 RearrangeSourceTable()
' hiker95, 10/14/2016, ME970491
Dim a As Variant, i As Long, c As Long, des As Range, lr As Long, nr As Long
Application.ScreenUpdating = False
With Sheets("Sheet1")
  lr = .Columns("I:J").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
  If lr > 1 Then .Range("I2:J" & lr).ClearContents
  a = .Range("A1:F" & .Range("A" & Rows.Count).End(xlUp).Row)
  For i = 2 To UBound(a, 1)
    For c = 2 To UBound(a, 2)
      If a(i, c) = "X" Then
        Set des = .Columns("N").Find(.Cells(1, c).Value, LookAt:=xlWhole)
        If Not des Is Nothing Then
          nr = .Cells(.Rows.Count, "I").End(xlUp).Row + 1
          .Cells(nr, 9).Value = a(i, 1)
          .Cells(nr, 10).Value = .Range("M" & des.Row).Value
        End If
      End If
    Next c
  Next i
End With
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, 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 RearrangeSourceTable macro

 

[MrSamExcel]

Give this a shot:
sincerely,
Max

Max - that worked like magic, thank you! (hiker95 - haven't tried yours yet but thanks for the response...will use it for self-education). This code is beyond my skill level, I thought I could adapt it to a modified version of the original request but having trouble. I'll keep working at it, could you try the same idea with the following?:

Source data looks like this:
Excel 2013 64 bit

	A​	B​	C​	D​	E​	F​	G​	H​	I​	J​
1​	Fund Code (SEE COMMENTS)	Fund Name	Growth​	Growth & Income​	Income​	Diversification​	Interest Rate Risk​	Downside Risk​	Purchasing Power​	Tax Efficiency​
2​	A	Fund ABC			X​	X​		X​		X​
3​	B	Fund XYZ	X​				X​
4​	C	Fund 123			X​	X​		X​

<tbody>
</tbody>

Sheet: 3Q (3)

<tbody>
</tbody>

I need two tables of results like this (they can be on same tabs or different, whatever is easier):

	M​	N​	O​	P​	Q​
1​	FundCode	OutComeId		FUNDCODE	ObjectiveId
2​	A	1​		A	13​
3​	A	3​		B	11​
4​	A	5​		C	13​
5​	B	2​
6​	C	1​
7​	C	3​

<tbody>
</tbody>

​
And the two associated keys are:

	M​	N​	O​	P​	Q​
13​	OutComeId	Description		ObjectiveId	Description
14​	1	Div		11	Growth
15​	2	Int		12	Growth & Income
16​	3	Down		13	Income
17​	4	Purch
18​	5	Tax

<tbody>
</tbody>

So it's essentially the same as the first example except there are a few extra fields, and if the "Objective" (Growth/G&I/Income) part of this is a hassle I can put that together with regular formulas pretty easily but thought I'd ask since your response to the first example was so impressive. Thanks again!

 

[hiker95]

hiker95 - haven't tried yours yet but thanks for the response...will use it for self-education

MrSamExcel,

You are welcome.

 

[Max1616]

Hi MrSamExcel,

(Sorry for the delayed response, I have been traveling for work the last few days)
Try this out for adding the Growth and Income table:

Option Explicit

Sub MrSamExcel()
Dim lrow As Long
Dim lclm As Integer
Dim ws As Worksheet
Dim Nws As Worksheet
Dim Keyws As Worksheet
Dim i As Long
Dim i2 As Integer
Dim Nlrow As Long

Set ws = ActiveSheet

lrow = Cells(Rows.Count, 1).End(xlUp).Row
lclm = Cells(1, Columns.Count).End(xlToLeft).Column

Set Nws = Sheets.Add
Set Keyws = Sheets.Add
Nws.Name = "Results"
Keyws.Name = "Keys"

Nws.Cells(1, 1) = "FundCode"
Nws.Cells(1, 2) = "OutComeId"

Nws.Cells(1, 4) = "FundCode"
Nws.Cells(1, 5) = "ObjectiveId"

Nlrow = 2

For i = 2 To lrow
    For i2 = 6 To lclm
        If ws.Cells(i, i2) <> "" Then
            Nws.Cells(Nlrow, 1) = ws.Cells(i, 1)
            Nws.Cells(Nlrow, 2) = i2 - 5
            Nlrow = Nws.Cells(Rows.Count, 1).End(xlUp).Row + 1
        End If
    Next i2
Next i
    
Nlrow = 2
    
For i = 2 To lrow
    For i2 = 3 To 5
        If ws.Cells(i, i2) <> "" Then
            Nws.Cells(Nlrow, 4) = ws.Cells(i, 1)
            Nws.Cells(Nlrow, 5) = i2 + 8
            Nlrow = Nws.Cells(Rows.Count, 4).End(xlUp).Row + 1
        End If
    Next i2
Next i
    
    
    
'Keys
Keyws.Cells(1, 1) = "OutComeId"
Keyws.Cells(1, 4) = "Description"

Keyws.Cells(2, 1) = 1
Keyws.Cells(3, 1) = 2
Keyws.Cells(4, 1) = 3
Keyws.Cells(5, 1) = 4
Keyws.Cells(6, 1) = 5
    
Keyws.Cells(2, 2) = "Div"
Keyws.Cells(3, 2) = "Int"
Keyws.Cells(4, 2) = "Down"
Keyws.Cells(5, 2) = "Purch"
Keyws.Cells(6, 2) = "Tax"

Keyws.Cells(1, 4) = "ObjectiveId"
Keyws.Cells(1, 5) = "Description"

Keyws.Cells(2, 4) = 11
Keyws.Cells(3, 4) = 12
Keyws.Cells(4, 4) = 13

Keyws.Cells(2, 5) = "Growth"
Keyws.Cells(3, 5) = "Growth & Income"
Keyws.Cells(4, 5) = "Income"
    
Nws.Activate
End Sub

Let me know if this doesn't work!

Sincerely,
Max

 

[MrSamExcel]

Perfect, thanks again Max! And after putting this code next to your original, I can see where I went wrong and now better understand the parameters.