Creating a database style list from a matrix/table

[Tuttle]

Morning all,

I have a matrix of data that I want to turn into a database type listing so I can use pivot tables on the data.

By way of example, I have a table that looks something like this:

	WBS ABC	WBS XYZ	WBS LMN
GL Code XYZ	$10,000
GL Code ABC	$12,000	$10,000
GL Code 123			$12,300

<tbody>
</tbody>

I need to arrange the data like this

GL Code XYZ	WBS ABC	$10,000
GL Code ABC	WBS ABC	$12,000
GL Code ABC	WBZ XYZ	$10,000
GL Code 123	WBS LMN	$12,300

<tbody>
</tbody>

The actual table I have is 8 rows by 53 columns and changes once a month.

Any tips on how to rearrange the data?

Tuttle.

 

[mrhstn]

Maybe a little bit of VBA code...

Here's a before and after

Book1
	A	B	C	D
1		WBS ABC	WBS XYZ	WBS LMN
2	GL Code XYZ	$10,000
3	GL Code ABC	$12,000	$10,000
4	GL Code 123			$12,300
5
6	After
7	GL Code XYZ	WBS ABC	£10,000
8	GL Code ABC	WBS ABC	£12,000
9	GL Code ABC	WBS XYZ	£10,000
10	GL Code 123	WBS LMN	£12,300
Sheet3

Here's the code I used

Option Explicit


Sub rearrange()
Dim i As Long
Dim j As Long
Dim counter As Long
counter = 7 ' change to which ever row you want the data to be reconfigured to
For i = 2 To 4 ' change 4 to total rows + 1
    For j = 2 To 4 ' change 4 to total columns + 1
        If Cells(i, j).Value <> "" Then
            Cells(counter, 1) = Cells(i, 1).Value
            Cells(counter, 2) = Cells(1, j).Value
            Cells(counter, 3) = Cells(i, j).Value
            counter = counter + 1
        End If
    Next j
Next i
End Sub

You will need to make adjustments to suit your exact needs.

 

[Tuttle]

Thanks - that works well.

How would you adjust the code to drop the output into a different sheet? I have three of these to do in a workbook that is about 20 sheets in size.

Tuttle.

 

[mrhstn]

One way to do it might be to bundle the values into an array and dump it in a newly created sheet. Example being...

Sub rearrangewitharray()
Dim Output() As Variant


counter = 0


ReDim Output(0 To 2, 0 To counter)
For i = 2 To 4
    For j = 2 To 4
        If Cells(i, j).Value <> "" Then
            Output(0, counter) = Cells(i, 1).Value
            Output(1, counter) = Cells(1, j).Value
            Output(2, counter) = Cells(i, j).Value
            counter = counter + 1
            ReDim Preserve Output(0 To 2, 0 To counter)
        End If
    Next j
Next i
Worksheets.Add
ActiveSheet.Cells(1, 1).Resize(UBound(Output, 2), UBound(Output, 1) + 1) = Application.Transpose(Output)
End Sub

This would add a new sheet and insert the data from A1. You could of course skip adding a sheet and reference an existing one.

 

[Mike Szczesny]

Can you use something like this. Assume your data is in A1:D4. Place your formulas in A6, B6, and C6. You need to use Cntrl+Shift+Enter for each formula. Copy down.The formula in C6 is a crazy complicated formula, but it is robust.
A6

=INDEX($A$2:$A$4,SMALL(IF($B$2:$D$4<>"",ROW($A$2:$A$4)-ROW($A$2)+1),ROWS($A$6:A6))) B6 =INDEX($B$1:$D$1,SMALL(IF($B$2:$D$4<>"",ROW($A$2:$A$4)-ROW($A$2)+1),ROWS($B$6:B6))) C6 =INDEX($B$2:$D$4,INT(SMALL(IF($B$2:$D$4<>"",(ROW($B$2:$D$4)-ROW($B$2)+1)*10^9+COLUMN($B$2:$D$4)-COLUMN($B$2)+1),ROWS($A$6:C6))/10^9),MOD(SMALL(IF($B$2:$D$4<>"",(ROW($B$2:$D$4)-ROW($B$2)+1)*10^9+COLUMN($B$2:$D$4)-COLUMN($B$2)+1),ROWS($A$6:C6)),10^9)) WBS ABC WBS XYZ WBS LMN GL Code XYZ 10000 GL Code ABC 12000 10000 GL Code 123 12300 GL Code XYZ WBS ABC 10000 GL Code ABC WBS XYZ 12000 GL Code ABC WBS XYZ 10000 GL Code 123 WBS LMN 12300 <colgroup><col><col span="3"></colgroup><tbody> </tbody> <tbody> </tbody> <tbody> </tbody>

<tbody>
</tbody>