Here is one you can try out...

Note... watch out for the line returns this newsgroup may apply to the
following code

Mark Ivey


Sub test()
Dim LastRowColA As Long
Dim i, j, k As Long

Dim A_Percents(1 To 12) As Integer
Dim B_Percents(1 To 12) As Integer
Dim C_Percents(1 To 12) As Integer

A_Percents(1) = 8
A_Percents(2) = 8
A_Percents(3) = 9
A_Percents(4) = 8
A_Percents(5) = 8
A_Percents(6) = 9
A_Percents(7) = 8
A_Percents(8) = 8
A_Percents(9) = 9
A_Percents(10) = 8
A_Percents(11) = 8
A_Percents(12) = 9

B_Percents(1) = 0
B_Percents(2) = 0
B_Percents(3) = 0
B_Percents(4) = 0
B_Percents(5) = 0
B_Percents(6) = 14
B_Percents(7) = 14
B_Percents(8) = 15
B_Percents(9) = 14
B_Percents(10) = 14
B_Percents(11) = 15
B_Percents(12) = 14

C_Percents(1) = 10
C_Percents(2) = 10
C_Percents(3) = 10
C_Percents(4) = 10
C_Percents(5) = 10
C_Percents(6) = 10
C_Percents(7) = 10
C_Percents(8) = 10
C_Percents(9) = 10
C_Percents(10) = 10
C_Percents(11) = 0
C_Percents(12) = 0


LastRowColA = Sheets(1).Range("A1").End(xlDown).Row

k = 2

For i = 1 To LastRowColA
If Cells(i, 1).Value = "A" Then
For j = 1 To UBound(A_Percents)
Sheets(2).Cells(k, 1).Value = "A"
Sheets(2).Cells(k, 2).Value = (A_Percents(j) / 100) *
Sheets(1).Cells(i, 2).Value
k = k + 1
Next
ElseIf Cells(i, 1).Value = "B" Then
For j = 1 To UBound(B_Percents)
Sheets(2).Cells(k, 1).Value = "B"
Sheets(2).Cells(k, 2).Value = (B_Percents(j) / 100) *
Sheets(1).Cells(i, 2).Value
k = k + 1
Next
ElseIf Cells(i, 1).Value = "C" Then
For j = 1 To UBound(C_Percents)
Sheets(2).Cells(k, 1).Value = "C"
Sheets(2).Cells(k, 2).Value = (C_Percents(j) / 100) *
Sheets(1).Cells(i, 2).Value
k = k + 1
Next
End If
Next

Sheets(2).Cells(1, 1).Value = "Code"
Sheets(2).Cells(1, 2).Value = "Amt"

End Sub