Rearrange Source Table

M

MrSamExcel

Board Regular
Joined
Apr 6, 2016
Messages
51
Office Version
  1. 365
  2. 2021
Platform
  1. Windows
I have a table that looks like this:
Excel 2013 64 bit
[TABLE="class: head"]
<tbody>[TR="bgcolor: #888888"]
[TH][/TH]
[TH]
A​
[/TH]
[TH]
B​
[/TH]
[TH]
C​
[/TH]
[TH]
D​
[/TH]
[TH]
E​
[/TH]
[TH]
F​
[/TH]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
1​
[/TD]
[TD]Name[/TD]
[TD]
Div​
[/TD]
[TD]
Int​
[/TD]
[TD]
Down​
[/TD]
[TD]
Purch​
[/TD]
[TD]
Tax​
[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
2​
[/TD]
[TD]A[/TD]
[TD]
X​
[/TD]
[TD][/TD]
[TD]
X​
[/TD]
[TD][/TD]
[TD]
X​
[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
3​
[/TD]
[TD]B[/TD]
[TD][/TD]
[TD]
X​
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
4​
[/TD]
[TD]C[/TD]
[TD]
X​
[/TD]
[TD][/TD]
[TD]
X​
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="class: grid"]
<tbody>[TR]
[TD]Sheet: Sheet1[/TD]
[/TR]
</tbody>[/TABLE]

I need it to look like this:
Excel 2013 64 bit
[TABLE="class: head"]
<tbody>[TR="bgcolor: #888888"]
[TH][/TH]
[TH]
I​
[/TH]
[TH]
J​
[/TH]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
1​
[/TD]
[TD]Name[/TD]
[TD]OutComeId[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
2​
[/TD]
[TD]A[/TD]
[TD]
1​
[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
3​
[/TD]
[TD]A[/TD]
[TD]
3​
[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
4​
[/TD]
[TD]A[/TD]
[TD]
5​
[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
5​
[/TD]
[TD]B[/TD]
[TD]
2​
[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
6​
[/TD]
[TD]C[/TD]
[TD]
1​
[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
7​
[/TD]
[TD]C[/TD]
[TD]
3​
[/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="class: grid"]
<tbody>[TR]
[TD]Sheet: Sheet1[/TD]
[/TR]
</tbody>[/TABLE]

and the "OutCome" key is as follows:
Excel 2013 64 bit
[TABLE="class: head"]
<tbody>[TR="bgcolor: #888888"]
[TH][/TH]
[TH]
M​
[/TH]
[TH]
N​
[/TH]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
1​
[/TD]
[TD]OutComeId[/TD]
[TD]Description[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
2​
[/TD]
[TD]1[/TD]
[TD]Div[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
3​
[/TD]
[TD]2[/TD]
[TD]Int[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
4​
[/TD]
[TD]3[/TD]
[TD]Down[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
5​
[/TD]
[TD]4[/TD]
[TD]Purch[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
6​
[/TD]
[TD]5[/TD]
[TD]Tax[/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="class: grid"]
<tbody>[TR]
[TD]Sheet: Sheet1[/TD]
[/TR]
</tbody>[/TABLE]

Any thoughts? Thanks.
 
Sort by date Sort by votes
Give this a shot:
Code: 
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
 
Upvote 0
MrSamExcel,

Here is a macro solution for you to consider.

Sample raw data:


Excel 2007
ABCDEFGHIJKLMN
1NameDivIntDownPurchTaxNameOutComeIdOutComeIdDescription
2AXXX1Div
3BX2Int
4CXX3Down
54Purch
65Tax
7
8
Sheet1


And, after the macro:


Excel 2007
ABCDEFGHIJKLMN
1NameDivIntDownPurchTaxNameOutComeIdOutComeIdDescription
2AXXXA11Div
3BXA32Int
4CXXA53Down
5B24Purch
6C15Tax
7C3
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).

Code: 
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
 
Last edited:
Upvote 0
Max1616 said:
Give this a shot:
sincerely,
Max
Click to expand...

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
[TABLE="class: head"]
<tbody>[TR="bgcolor: #888888"]
[TH][/TH]
[TH]
A​
[/TH]
[TH]
B​
[/TH]
[TH]
C​
[/TH]
[TH]
D​
[/TH]
[TH]
E​
[/TH]
[TH]
F​
[/TH]
[TH]
G​
[/TH]
[TH]
H​
[/TH]
[TH]
I​
[/TH]
[TH]
J​
[/TH]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
1​
[/TD]
[TD="bgcolor: #00B050"]Fund Code (SEE COMMENTS)[/TD]
[TD]Fund Name[/TD]
[TD="bgcolor: #D6DCE4"]
Growth​
[/TD]
[TD="bgcolor: #D6DCE4"]
Growth & Income​
[/TD]
[TD="bgcolor: #D6DCE4"]
Income​
[/TD]
[TD="bgcolor: #EDEDED"]
Diversification​
[/TD]
[TD="bgcolor: #EDEDED"]
Interest Rate Risk​
[/TD]
[TD="bgcolor: #EDEDED"]
Downside Risk​
[/TD]
[TD="bgcolor: #EDEDED"]
Purchasing Power​
[/TD]
[TD="bgcolor: #EDEDED"]
Tax Efficiency​
[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
2​
[/TD]
[TD]A[/TD]
[TD]Fund ABC[/TD]
[TD][/TD]
[TD][/TD]
[TD]
X​
[/TD]
[TD]
X​
[/TD]
[TD][/TD]
[TD]
X​
[/TD]
[TD][/TD]
[TD]
X​
[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
3​
[/TD]
[TD]B[/TD]
[TD]Fund XYZ[/TD]
[TD]
X​
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]
X​
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
4​
[/TD]
[TD]C[/TD]
[TD]Fund 123[/TD]
[TD][/TD]
[TD][/TD]
[TD]
X​
[/TD]
[TD]
X​
[/TD]
[TD][/TD]
[TD]
X​
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="class: grid"]
<tbody>[TR]
[TD]Sheet: 3Q (3)[/TD]
[/TR]
</tbody>[/TABLE]


I need two tables of results like this (they can be on same tabs or different, whatever is easier):
[TABLE="class: head"]
<tbody>[TR="bgcolor: #888888"]
[TH][/TH]
[TH]
M​
[/TH]
[TH]
N​
[/TH]
[TH]
O​
[/TH]
[TH]
P​
[/TH]
[TH]
Q​
[/TH]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
1​
[/TD]
[TD]FundCode[/TD]
[TD]OutComeId[/TD]
[TD][/TD]
[TD]FUNDCODE[/TD]
[TD]ObjectiveId[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
2​
[/TD]
[TD]A[/TD]
[TD]
1​
[/TD]
[TD][/TD]
[TD]A[/TD]
[TD]
13​
[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
3​
[/TD]
[TD]A[/TD]
[TD]
3​
[/TD]
[TD][/TD]
[TD]B[/TD]
[TD]
11​
[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
4​
[/TD]
[TD]A[/TD]
[TD]
5​
[/TD]
[TD][/TD]
[TD]C[/TD]
[TD]
13​
[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
5​
[/TD]
[TD]B[/TD]
[TD]
2​
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
6​
[/TD]
[TD]C[/TD]
[TD]
1​
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
7​
[/TD]
[TD]C[/TD]
[TD]
3​
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
​
And the two associated keys are:

[TABLE="class: head"]
<tbody>[TR="bgcolor: #888888"]
[TH][/TH]
[TH]
M​
[/TH]
[TH]
N​
[/TH]
[TH]
O​
[/TH]
[TH]
P​
[/TH]
[TH]
Q​
[/TH]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
13​
[/TD]
[TD]OutComeId[/TD]
[TD]Description[/TD]
[TD][/TD]
[TD]ObjectiveId[/TD]
[TD]Description[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
14​
[/TD]
[TD]1[/TD]
[TD]Div[/TD]
[TD][/TD]
[TD]11[/TD]
[TD]Growth[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
15​
[/TD]
[TD]2[/TD]
[TD]Int[/TD]
[TD][/TD]
[TD]12[/TD]
[TD]Growth & Income[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
16​
[/TD]
[TD]3[/TD]
[TD]Down[/TD]
[TD][/TD]
[TD]13[/TD]
[TD]Income[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
17​
[/TD]
[TD]4[/TD]
[TD]Purch[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
18​
[/TD]
[TD]5[/TD]
[TD]Tax[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

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!
 
Upvote 0
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:

Code: 
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
 
Upvote 0
Solution
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.
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Question Question
VBA Generate email with multiple data in body.
Replies
2
Views
436
Logit
Logit
N
  • Solved
Formula to consolidate Data and remove entries with no data in that year
2
Replies
10
Views
415
Newbie73
N
G
  • Question Question
Rearrange data into two columns
Replies
3
Views
133
Fluff
Fluff
A
  • Question Question
Bold and color text
Replies
4
Views
91
Kaper
Kaper
H
  • Question Question
Copy Tables & Charts from Excel to Powerpoint, Keep source formatting and change position
Replies
0
Views
563
h899
H

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top