About Us

K[_2_]

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

Thread Tools	Search this Thread
Show Printable Version	Search this Thread: Advanced Search
Display Modes
Switch to Linear Mode Switch to Hybrid Mode Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
MACRO FOR DELETING DEBIT AND CREDIT FIGURES ROWS	K[_2_]	Excel Programming	1	February 5th 08 05:10 PM
Macro help:replacing figures	phil2006[_5_]	Excel Programming	1	June 5th 06 02:59 PM
Macro help:replacing figures	phil2006	Excel Discussion (Misc queries)	0	June 5th 06 02:40 PM
negative figures macro	tweacle	Excel Worksheet Functions	0	January 22nd 06 11:17 AM
Changing positive figures to minus figures	Louise	Excel Worksheet Functions	2	September 14th 05 10:05 AM

Menu

About Us