HOW TO SPLIT FIGURES BY MACRO

K

K

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
 
M

Mark Ivey

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
 
K

K

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
Click to expand...

Thanks lot Mark you macro work fine
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

PLEASE HELP ! "SPLIT AMOUNT BY MACRO" 1
PLEASE HELP - HOW TO SPLIT AMOUNT BY MACRO 1
Access Running Balance in Access 1
Excell 2003 VBA Code needs 1
PLEASE HELP - MACRO NEEDED 2
modified pivot table using a macro 2
WCG Stats Saturday 26 September 2020 2
WCG Stats Friday 02 October 2020 1

Top