Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
DiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWord
DirectoryUser Groups
Related Topics
Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ...
MS Office Forum / Excel / Programming / April 2008

Tip: Looking for answers? Try searching our database.

CAN ANYBODY PLEASE HELP ME WITH THIS MACRO

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
K - 17 Apr 2008 23:14 GMT
macro below works perfectly fine as it get percentages of Sheet1
column E amounts and other data in same row to Sheet2

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

Dim A_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

LastRowColD = Sheets(1).Range("D1").End(xlDown).Row

k = 2

For i = 2 To LastRowColD
If Cells(i, 4).Value = "A" Then
For j = 1 To UBound(A_Percents)
Sheets(2).Cells(k, 1).Value = Sheets(1).Cells(i, 1).Value
Sheets(2).Cells(k, 2).Value = Sheets(1).Cells(i, 2).Value
Sheets(2).Cells(k, 3).Value = Sheets(1).Cells(i, 3).Value
Sheets(2).Cells(k, 4).Value = "A"
Sheets(2).Cells(k, 5).Value = (A_Percents(j) / 100) *
Sheets(1).Cells(i, 5).Value
Sheets(2).Cells(k, 6).Value = Sheets(1).Cells(i, 6).Value
k = k + 1
Next
End If
Next

Sheets(2).Cells(1, 1).Value = "AC"
Sheets(2).Cells(1, 2).Value = "CO"
Sheets(2).Cells(1, 3).Value = "FO"
Sheets(2).Cells(1, 4).Value = "CODE"
Sheets(2).Cells(1, 5).Value = "AMT"
Sheets(2).Cells(1, 6).Value = "DETAIL"

End Sub

I want macro to put period code which will be 200801,200802 etc with
each percentage of amount in column 7 of Sheet2. by doing this it
will
tell that how much percentage figure will be there in specific
period.
So I tried doing some changes in above macro (see macro below) but
for
some reason its not working.  Please anybody can tell that what i am
doing wrong and can suggest any thing.  I want periods to be appear
in
column 7 of Sheet2. for example if amount of 1000 have divided by
percentage given in macro then result should be something like this
(see below). (Note:- i am just showing column E and G result below)

E         G --- col
80   200801
80   200802
90   200803
80   200804
80   200805
90   200806
80   200807
80   200808
90   200809
80   200810
80   200811
90   200812

(CHANGED MACRO)

Sub test()
Dim LastRowColD As Long
Dim i, J, k, t As Long

Dim A_Percents(1 To 12) As Integer
Dim MTH(1 To 12) As Integer

MTH(1) = 200801
MTH(2) = 200802
MTH(3) = 200803
MTH(4) = 200804
MTH(5) = 200805
MTH(6) = 200806
MTH(7) = 200807
MTH(8) = 200808
MTH(9) = 200809
MTH(10) = 200810
MTH(11) = 200811
MTH(12) = 200812

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

LastRowColD = Sheets(1).Range("D1").End(xlDown).Row

k = 2

For i = 2 To LastRowColD
If Cells(i, 4).Value = "A" Then
For J = 1 To UBound(A_Percents)
For t = 1 To UBound(MTH)
Sheets(2).Cells(k, 1).Value = Sheets(1).Cells(i, 1).Value
Sheets(2).Cells(k, 2).Value = Sheets(1).Cells(i, 2).Value
Sheets(2).Cells(k, 3).Value = Sheets(1).Cells(i, 3).Value
Sheets(2).Cells(k, 4).Value = "A"
Sheets(2).Cells(k, 5).Value = (A_Percents(J) / 100) *
Sheets(1).Cells(i, 5).Value
Sheets(2).Cells(k, 6).Value = Sheets(1).Cells(i, 6).Value
Sheets(2).Cells(k, 7).Value = MTH(t)
k = k + 1
Next
End If
Next

Sheets(2).Cells(1, 1).Value = "AC"
Sheets(2).Cells(1, 2).Value = "CO"
Sheets(2).Cells(1, 3).Value = "FO"
Sheets(2).Cells(1, 4).Value = "CODE"
Sheets(2).Cells(1, 5).Value = "AMT"
Sheets(2).Cells(1, 6).Value = "DETAIL"
Sheets(2).Cells(1, 7).Value = "PERIOD"

End Sub
Reply to this Message
Mark Ivey - 18 Apr 2008 02:43 GMT
Without seeing the data on your sheet, I can only speculate at what might
work for you...

I found a few mistakes with your code by running it through debug mode...

Here are the fixes I would recommend.

Mark Ivey

Sub test2()
   Dim LastRowColD As Long
   Dim i, J, k, t As Long

   Dim A_Percents(1 To 12) As Integer
   Dim MTH(1 To 12) As Long   ' changed type due to value being a long
number

   MTH(1) = 200801
   MTH(2) = 200802
   MTH(3) = 200803
   MTH(4) = 200804
   MTH(5) = 200805
   MTH(6) = 200806
   MTH(7) = 200807
   MTH(8) = 200808
   MTH(9) = 200809
   MTH(10) = 200810
   MTH(11) = 200811
   MTH(12) = 200812

   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

   LastRowColD = Sheets(1).Range("D1").End(xlDown).Row

   k = 2

   For i = 2 To LastRowColD
       If Cells(i, 4).Value = "A" Then
           For J = 1 To UBound(A_Percents)
               For t = 1 To UBound(MTH)
                   Sheets(2).Cells(k, 1).Value = Sheets(1).Cells(i,
1).Value
                   Sheets(2).Cells(k, 2).Value = Sheets(1).Cells(i,
2).Value
                   Sheets(2).Cells(k, 3).Value = Sheets(1).Cells(i,
3).Value
                   Sheets(2).Cells(k, 4).Value = "A"
                   Sheets(2).Cells(k, 5).Value = (A_Percents(J) / 100) * _
                                                 Sheets(1).Cells(i,
5).Value
                   Sheets(2).Cells(k, 6).Value = Sheets(1).Cells(i,
6).Value
                   Sheets(2).Cells(k, 7).Value = MTH(t)
                   k = k + 1
               Next
           Next    ' added a next statement for the second FOR loop
       End If
   Next

   Sheets(2).Cells(1, 1).Value = "AC"
   Sheets(2).Cells(1, 2).Value = "CO"
   Sheets(2).Cells(1, 3).Value = "FO"
   Sheets(2).Cells(1, 4).Value = "CODE"
   Sheets(2).Cells(1, 5).Value = "AMT"
   Sheets(2).Cells(1, 6).Value = "DETAIL"
   Sheets(2).Cells(1, 7).Value = "PERIOD"
End Sub
Reply to this Message
K - 18 Apr 2008 08:26 GMT
> Without seeing the data on your sheet, I can only speculate at what might
> work for you...
[quoted text clipped - 74 lines]
>     Sheets(2).Cells(1, 7).Value = "PERIOD"
> End Sub

Thanks for replying Mark. I been struggling to get this answer from
long time.  Your macro work fine but it just sligtly giving different
result.
Please see the excel file in link below which I have uploaded on
www.savefile.com.  I have explained everything in this file. hope
you'll understand what i am trying to say. Please do reply.

http://www.savefile.com/files/1511153
Reply to this Message
Mark Ivey - 18 Apr 2008 11:27 GMT
I will take a closer look at it this evening when I get home from work...

Mark Ivey

>> Without seeing the data on your sheet, I can only speculate at what might
>> work for you...
[quoted text clipped - 83 lines]
>
> http://www.savefile.com/files/1511153
Reply to this Message
K - 18 Apr 2008 11:20 GMT
> Without seeing the data on your sheet, I can only speculate at what might
> work for you...
[quoted text clipped - 74 lines]
>     Sheets(2).Cells(1, 7).Value = "PERIOD"
> End Sub

hi mark , thanks for replying i been struggling to get answer for this
question from long time now.  your macro works fine but it giving bit
different result.  please see my excel file in link below in which i
explained every thing.  hope fully you can understand what i am tring
to say. please please do reply.
http://www.savefile.com/files/1511153
Reply to this Message
Mark Ivey - 18 Apr 2008 11:36 GMT
I will see if I have some time at work today to take a look at it...

Otherwise it will be tonight before I can get back on it.

Mark Ivey

>> Without seeing the data on your sheet, I can only speculate at what might
>> work for you...
[quoted text clipped - 81 lines]
> to say. please please do reply.
> http://www.savefile.com/files/1511153
Reply to this Message
Mark Ivey - 18 Apr 2008 11:57 GMT
K,

Just took a quick minute to review what you had....

Thanks for uploading the file. It really helped me better understand what
you were needing.

I think I found your problem. You had 2 FOR loops. One for the "A_Percents"
array, and one for the "MTH" array. Take note, the FOR loops were just used
to reference a specific INDEX point for each array. Since you want them
synchronized anyway you can do this job with just ONE FOR loop (as seen
below in the updated code). You can use the same INDEX position from one
array to do the same job in the other array.

What was happening in the last macro is that each array was being reference
12 times... In other words 12 times 12 equals 144 results.

I think the code below will get this issue fixed.

Mark Ivey

Sub test2()
   Dim LastRowColD As Long
   Dim i, J, k, t As Long

   Dim A_Percents(1 To 12) As Integer
   Dim MTH(1 To 12) As Long   ' changed type due to value being a long
Number

   MTH(1) = 200801
   MTH(2) = 200802
   MTH(3) = 200803
   MTH(4) = 200804
   MTH(5) = 200805
   MTH(6) = 200806
   MTH(7) = 200807
   MTH(8) = 200808
   MTH(9) = 200809
   MTH(10) = 200810
   MTH(11) = 200811
   MTH(12) = 200812

   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

   LastRowColD = Sheets(1).Range("D1").End(xlDown).Row

   k = 2

   For i = 2 To LastRowColD
       If Cells(i, 4).Value = "A" Then
           For J = 1 To UBound(A_Percents)
               Sheets(2).Cells(k, 1).Value = Sheets(1).Cells(i, 1).Value
               Sheets(2).Cells(k, 2).Value = Sheets(1).Cells(i, 2).Value
               Sheets(2).Cells(k, 3).Value = Sheets(1).Cells(i, 3).Value
               Sheets(2).Cells(k, 4).Value = "A"
               Sheets(2).Cells(k, 5).Value = (A_Percents(J) / 100) *
Sheets(1).Cells(i, 5).Value
               Sheets(2).Cells(k, 6).Value = Sheets(1).Cells(i, 6).Value
               Sheets(2).Cells(k, 7).Value = MTH(J)
               k = k + 1
           Next
       End If
   Next

   Sheets(2).Cells(1, 1).Value = "AC"
   Sheets(2).Cells(1, 2).Value = "CO"
   Sheets(2).Cells(1, 3).Value = "FO"
   Sheets(2).Cells(1, 4).Value = "CODE"
   Sheets(2).Cells(1, 5).Value = "AMT"
   Sheets(2).Cells(1, 6).Value = "DETAIL"
   Sheets(2).Cells(1, 7).Value = "PERIOD"
End Sub
Reply to this Message
K - 18 Apr 2008 20:31 GMT
> K,
>
[quoted text clipped - 79 lines]
>     Sheets(2).Cells(1, 7).Value = "PERIOD"
> End Sub

Thanks a lot Mark for your help you really solved my problem.  Just a
small question that if i have percentages in decimals like for example
A_Percents(1) = 7.69
A_Percents(2) = 8.59
A_Percents(3) = 10
A_Percents(4) = 8
A_Percents(5) = 9.44
A_Percents(6) = 6
A_Percents(7) = 7.15
A_Percents(8) = 20.02
A_Percents(9) = 3.33
A_Percents(10) = 5.58
A_Percents(11) = 10.23
A_Percents(12) = 3.97
and when these percentages get multiplied by the amount we say like
2170 then obvesly i'll get result in decimals. Is there way that we
can round figures just doing some change in code "Sheets(2).Cells(k,
5).Value = (A_Percents(J) / 100) *
Sheets(1).Cells(i, 5).Value" in above macro so i can get figures
rounded to near 10 or 100. i know i am asking to many question but
please this is the last bit.  i try to ask question in bits on this
google group in case if someone dont understand my big question. once
again thanks a lot for you all help
Reply to this Message
Mark Ivey - 19 Apr 2008 02:22 GMT
Not totally sure about the rounding bit just yet, but the code below will
get rid of the decimal point for now...

Mark Ivey

Sub test3()

   Dim LastRowColD As Long
   Dim i, J, k, t As Long

   Dim A_Percents(1 To 12) As Integer
   Dim MTH(1 To 12) As Long   ' changed type due to value being a long
Number

   MTH(1) = 200801
   MTH(2) = 200802
   MTH(3) = 200803
   MTH(4) = 200804
   MTH(5) = 200805
   MTH(6) = 200806
   MTH(7) = 200807
   MTH(8) = 200808
   MTH(9) = 200809
   MTH(10) = 200810
   MTH(11) = 200811
   MTH(12) = 200812

   A_Percents(1) = 7.69
   A_Percents(2) = 8.59
   A_Percents(3) = 10
   A_Percents(4) = 8
   A_Percents(5) = 9.44
   A_Percents(6) = 6
   A_Percents(7) = 7.15
   A_Percents(8) = 20.02
   A_Percents(9) = 3.33
   A_Percents(10) = 5.58
   A_Percents(11) = 10.23
   A_Percents(12) = 3.97

   LastRowColD = Sheets(1).Range("D1").End(xlDown).Row

   k = 2

   For i = 2 To LastRowColD
       If Cells(i, 4).Value = "A" Then
           For J = 1 To UBound(A_Percents)
               Sheets(2).Cells(k, 1).Value = Sheets(1).Cells(i, 1).Value
               Sheets(2).Cells(k, 2).Value = Sheets(1).Cells(i, 2).Value
               Sheets(2).Cells(k, 3).Value = Sheets(1).Cells(i, 3).Value
               Sheets(2).Cells(k, 4).Value = "A"
               Sheets(2).Cells(k, 5).Value = (A_Percents(J) / 100) * _
               Sheets(1).Cells(i, 5).Value
               Sheets(2).Cells(k, 5).NumberFormat = "0"
               Sheets(2).Cells(k, 6).Value = Sheets(1).Cells(i, 6).Value
               Sheets(2).Cells(k, 7).Value = MTH(J)
               k = k + 1
           Next
       End If
   Next

   Sheets(2).Cells(1, 1).Value = "AC"
   Sheets(2).Cells(1, 2).Value = "CO"
   Sheets(2).Cells(1, 3).Value = "FO"
   Sheets(2).Cells(1, 4).Value = "CODE"
   Sheets(2).Cells(1, 5).Value = "AMT"
   Sheets(2).Cells(1, 6).Value = "DETAIL"
   Sheets(2).Cells(1, 7).Value = "PERIOD"

End Sub
Reply to this Message
Mark Ivey - 19 Apr 2008 02:36 GMT
K,

Just figured out a workaround....

If we use the worksheet function to round the result, it will round it to
the closest 10's place. Take a look at the following code.

Mark Ivey

Sub test4()

   Dim LastRowColD As Long
   Dim i, J, k, t As Long

   Dim A_Percents(1 To 12) As Integer
   Dim MTH(1 To 12) As Long   ' changed type due to value being a long
Number

   MTH(1) = 200801
   MTH(2) = 200802
   MTH(3) = 200803
   MTH(4) = 200804
   MTH(5) = 200805
   MTH(6) = 200806
   MTH(7) = 200807
   MTH(8) = 200808
   MTH(9) = 200809
   MTH(10) = 200810
   MTH(11) = 200811
   MTH(12) = 200812

   A_Percents(1) = 7.69
   A_Percents(2) = 8.59
   A_Percents(3) = 10
   A_Percents(4) = 8
   A_Percents(5) = 9.44
   A_Percents(6) = 6
   A_Percents(7) = 7.15
   A_Percents(8) = 20.02
   A_Percents(9) = 3.33
   A_Percents(10) = 5.58
   A_Percents(11) = 10.23
   A_Percents(12) = 3.97

   LastRowColD = Sheets(1).Range("D1").End(xlDown).Row

   k = 2

   For i = 2 To LastRowColD
       If Cells(i, 4).Value = "A" Then
           For J = 1 To UBound(A_Percents)
               Sheets(2).Cells(k, 1).Value = Sheets(1).Cells(i, 1).Value
               Sheets(2).Cells(k, 2).Value = Sheets(1).Cells(i, 2).Value
               Sheets(2).Cells(k, 3).Value = Sheets(1).Cells(i, 3).Value
               Sheets(2).Cells(k, 4).Value = "A"
               Sheets(2).Cells(k, 5).Value = Application.WorksheetFunction
_
                   .Round((A_Percents(J) / 100) * Sheets(1).Cells(i,
5).Value, -1)

               Sheets(2).Cells(k, 6).Value = Sheets(1).Cells(i, 6).Value
               Sheets(2).Cells(k, 7).Value = MTH(J)
               k = k + 1
           Next
       End If
   Next

   Sheets(2).Cells(1, 1).Value = "AC"
   Sheets(2).Cells(1, 2).Value = "CO"
   Sheets(2).Cells(1, 3).Value = "FO"
   Sheets(2).Cells(1, 4).Value = "CODE"
   Sheets(2).Cells(1, 5).Value = "AMT"
   Sheets(2).Cells(1, 6).Value = "DETAIL"
   Sheets(2).Cells(1, 7).Value = "PERIOD"

End Sub
Reply to this Message
K - 19 Apr 2008 09:46 GMT
> K,
>
[quoted text clipped - 72 lines]
>
> End Sub

Thanks a lot Mark you have given me what i wanted. Man you are genious
in macro field.  hope fuly i'll learn lot from you in future.  Thanks
again for you help and time
Reply to this Message
Mark Ivey - 19 Apr 2008 13:21 GMT
No problem...

Glad I could help out...

If you are interested in learning more... there are lots of websites you can
look through to learn just about everything you need.

Here are a few to get you started.

Chip Pearson
http://www.cpearson.com/excel/MainPage.aspx

David McRitchie
http://www.mvps.org/dmcritchie/excel/excel.htm

Jon Peltier
http://peltiertech.com/

Mark Ivey

>> K,
>>
[quoted text clipped - 76 lines]
> in macro field.  hope fuly i'll learn lot from you in future.  Thanks
> again for you help and time
Reply to this Message
 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage
Start New Thread
Enable EMail Alerts
Rate this Thread



©2008 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.