On 12 Apr, 03:29, "Mark Ivey" wrote:
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

Thanks lot Mark you macro work fine