Monday, July 26, 2010

Convert Table To List

This is a code I wrote to convert a table (values and headers) to a list, so it can easily be manipulated using pivot tables or loaded intro a database. I posted this two years ago on the excellent Ozgrid Forums, so it makes sense I share it here too. It was tested on Excel 2003, but it should work in 2007/2010. Let me know if it doesn't.

Imagine you have this table:

  a b

c 1 2

d 3 4

The result would be this list:

1 a c

2 b c

3 a d

4 b d

It support headers with more than one row or column.

Here is the code:

Public Sub TableToList()
    Dim tabela As Range
    Dim cabColunas As Range
    Dim cabLinhas As Range
    Dim nColunas As Integer
    Dim nLinhas As Integer
    Dim nCabColunas As Integer
    Dim nCabLinhas As Integer
    Dim i As Integer
    Dim j As Integer
    Set tabela = Application.InputBox("Select Table", Type:=8)
    Set cabColunas = Application.InputBox("Select Column Labels)", Type:=8)
    Set cabLinhas = Application.InputBox("Select Row Labels", Type:=8)
    nColunas = cabColunas.Columns.Count
    nLinhas = cabLinhas.Rows.Count
    nCabColunas = cabColunas.Rows.Count
    nCabLinhas = cabLinhas.Columns.Count
    'size check
    If cabColunas.Columns.Count <> tabela.Columns.Count Then
        MsgBox ("Column Header should have the same # of columns the table has")
        Exit Sub
    End If
    If cabLinhas.Rows.Count <> tabela.Rows.Count Then
        MsgBox ("Row Header should have the same # of rows the table has")
        Exit Sub
    End If
    'creates sheet
    'fills the list
    For i = 1 To nColunas * nLinhas
        Range("A" & i).Value = tabela(i).Value
        For j = 1 To nCabColunas
            If i Mod nColunas = 0 Then
                Cells(i, j + 1).Value = cabColunas(nColunas * j)
                Else: Cells(i, j + 1).Value = cabColunas(i Mod nColunas + nColunas * (j - 1))
            End If
        For j = 1 To nCabLinhas
            Cells(i, j + 1 + nCabColunas).Value = cabLinhas(Int((i - 1) / nColunas) * nCabLinhas + j)
End Sub

1 comment: