Hi,
In column "A" of "Sheet 1" I will put codes like "A" , "B" , "C" and
in
column "B" of "Sheet 1" I have amount figures


A B -------columns
A 1000
B 2000
C 3000


i want macro to split amount of column "B" when i put any code ("A , B
or C") in column "A". the percentage of codes are below.

A B C----Columns
A B C ----Codes
8 0 10---percentages
8 0 10
9 0 10
8 0 10
8 0 10
9 14 10
8 14 10
8 15 10
9 14 10
8 14 10
8 15 0
9 14 0

macro should throw all result in "Sheet 2". for example if i put code
"A" in cell "A1 and amount 1000 in "B1" then macro should go through
the percentage of code "A" as shown above and then start spliting 1000
like (8/100*1000) then in cell below (8/100*1000) and so on. And when
i put code "B" in cell "A2" and amount 2000 then macro should go
through code "B" percentages and put all split below the previous
split in "Sheet 2"

Macro should produce result something like this in "Sheet 2" (see
below)


A B ------Columns
Code Amt -----Headings
A 80
A 80
A 90
A 80
A 80
A 90
A 80
A 80
A 90
A 80
A 80
A 90
B 0
B 0
B 0
B 0
B 0
B 280
B 280
B 300
B 280
B 280
B 300
B 280
C 300
C 300
C 300
C 300
C 300
C 300
C 300
C 300
C 300
C 300
C 0
C 0

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

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