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