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() 'variables 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 Worksheets.Add '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 Next For j = 1 To nCabLinhas Cells(i, j + 1 + nCabColunas).Value = cabLinhas(Int((i - 1) / nColunas) * nCabLinhas + j) Next Next End Sub
Great macro, thank you
ReplyDelete