Well, given that the number of groups of A, B, and C
change, so that the example below has 3 groups of ABC,
while you may want to have 5, 6, 7, etc groups.
Given the organization that you presently have, you can
only get 255 groups of ABC, because you have A, B, and C,
on the left side, with all your groups going to the
right. Further limited by the fact that Excel only allows
256 columns, so if you have 256 people/items you will have
1 column with ABC, 255 with the data, and no room for the
256th person/item.
So I would suggest you arrange your original data to be
like this.
A B C
4 0 2
3 1 0
0 5 2
Then, being sure that you have data in each row for each
set of ABC that you want, (Don't leave a zero cell as a
blank cell) you can go down the list, identify the number
of "groups" that you will be producing, and formulate your
lists that you want, like you did below:
A A B
A A B
A A B
A B B
C B
C C
C
It may be best to "start" this list production by using a
button to start the macro, otherwise you could use the
worksheet event for data change.
Using a button though... After the data is entered, ie. a
row of data 4 3 2. Select the button, and the resulting
list gets created.
So, the code to do this? Given a button, have the button
run the following code.
Public Sub Button_Click()
dim NumRows as integer
Dim NumCols as integer
Dim I as integer
Dim J as integer
Dim K as integer
dim DataRow as integer
Dim CurCol as integer
NumRows = GetNumRows()
NumCols = GetNumCols()
dim Data(NumCols, NumRows) as integer
'This assigns data to a two dimensional array
' The first dimension is the Columns (Not likely to
' change)
' The second dimension is the number of Rows (Likely
' to change)
For I = 1 to NumCols
For J = 2 to NumRows + 1
Data(I, J - 1) = ActiveSheet.Cells(I, J)
Next J
Next I
'Now that the data is stored, you can create your lists.
CurCol = 10 'Starts putting list in Column 10 ('J')
For I = 1 to NumRows
DataRow = 1 'Starts putting data in Row 1 of CurCol
For J = 1 to NumCols
Select Case J
case 1 ' Represents A
for K = 1 to Data(I, J)
ActiveSheet.Cells(DataRow, CurCol) = "A"
DataRow = DataRow + 1
Next K
case 2 ' Represents B
for K = 1 to Data(I, J)
ActiveSheet.Cells(DataRow, CurCol) = "B"
DataRow = DataRow + 1
Next K
case 3 ' Represents C
for K = 1 to Data(I, J)
ActiveSheet.Cells(DataRow, CurCol) = "C"
DataRow = DataRow + 1
Next K
End select
Next J
Curcol = CurCol + 1
Next I
end sub
private function GetNumRows() as integer
Dim I as integer
I = 2 'Starts at 2 because row 1 is your "header"
'Starts at Row I (2) , col 1
while ActiveSheet.Cells(i, 1) <> ""
I = I + 1
wend
If I = 2 then I = 1 'No data to be found
GetNumRows = I - 1
end function
private function GetNumCols() as integer
Dim I as integer
I = 1 'Starts at 1 because Col 1 is your first "header"
'Starts at Row 1, col I (1)
while ActiveSheet.Cells(1, I) <> ""
I = I + 1
wend
If I = 1 then I = 1 'No data to be found
GetNumCols = I -1 'Returns one less than I because
'returning only the number of columns actually having
' data.
end function
With the above code, and your original data in the format
that I spoke about way up there, this code will produce
the results that you are looking for. (Hopefully, I didn't
test it myself.) But the idea is there.
Have fun.
