PLEASE HELP MACRO NEEDED
 

Please see the post below

http://groups.google.co.uk/group/mic...faf5664?hl=en#

if anybody cannot understand my question in above post please see my
excel sheet which i have uploaded on "savefile.com" and put the link
below to see that file. i have explained more clearly what i want.
Please please if anybody can help

FILE LINK (see below)

http://www.savefile.com/files/1521549

PLEASE HELP MACRO NEEDED
 

On 24 Apr, 22:13, K wrote:
Please see the post below

http://groups.google.co.uk/group/mic....programming/b...

if anybody cannot understand my question in above post please see my
excel sheet which i have uploaded on "savefile.com" and put the link
below to see that file. i have explained more clearly what i want.
Please please if anybody can help

FILE LINK (see below)

http://www.savefile.com/files/1521549

Phillip London UK

This works for me
Paste the following code into a standard module

Sub DoReport()
DoCalcs Sheet1.Range("A3:A14"), "GX", Sheet2.Range("B1"), False
DoCalcs Sheet1.Range("B3:B14"), "GT", Sheet2.Range("B2"), True
End Sub

Private Sub DoCalcs(Rg As Range, Cde As String, Multi As Long, flag As
Boolean)
Dim cl As Range
Dim startcell As Range
Dim total As Long
Dim roundamount As Long
Dim adjust As Long
Dim curcell As Range
Static oset As Long
Set startcell = Sheet3.Range("A2")
For Each cl In Rg
startcell.Offset(oset, 0).Value = Cde
roundamount = WorksheetFunction.Round((cl.Value / 100) *
Multi, 0)
startcell.Offset(oset, 1).Value = roundamount
If roundamount = 1 Then
Set curcell = startcell.Offset(oset, 1)
End If
oset = oset + 1
total = total + roundamount
Next
adjust = Multi - total
curcell.Value = curcell.Value + adjust
If flag Then oset = 0
End Sub

PLEASE HELP MACRO NEEDED
 

On 26 Apr, 02:15, Phillip wrote:
On 24 Apr, 22:13, K wrote:

Please see the post below

http://groups.google.co.uk/group/mic....programming/b...

if anybody cannot understand my question in above post please see my
excel sheet which i have uploaded on "savefile.com" and put the link
below to see that file. i have explained more clearly what i want.
Please please if anybody can help

FILE LINK (see below)

http://www.savefile.com/files/1521549

Phillip London UK

This works for me
Paste the following code into a standard module

Sub DoReport()
* * DoCalcs Sheet1.Range("A3:A14"), "GX", Sheet2.Range("B1"), False
* * DoCalcs Sheet1.Range("B3:B14"), "GT", Sheet2.Range("B2"), True
End Sub

Private Sub DoCalcs(Rg As Range, Cde As String, Multi As Long, flag As
Boolean)
* * Dim cl As Range
* * Dim startcell As Range
* * Dim total As Long
* * Dim roundamount As Long
* * Dim adjust As Long
* * Dim curcell As Range
* * Static oset As Long
* * Set startcell = Sheet3.Range("A2")
* * For Each cl In Rg
* * * * startcell.Offset(oset, 0).Value = Cde
* * * * roundamount = WorksheetFunction.Round((cl.Value / 100) *
Multi, 0)
* * * * startcell.Offset(oset, 1).Value = roundamount
* * * * If roundamount = 1 Then
* * * * Set curcell = startcell.Offset(oset, 1)
* * * * End If
* * * * oset = oset + 1
* * * * total = total + roundamount
* * Next
* * adjust = Multi - total
* * curcell.Value = curcell.Value + adjust
* * If flag Then oset = 0
End Sub

Thanks Philip for replying. i havnt tried your macro yet but i'll go
to office on Monday and will try your code and let you know if i have
any question. Thanks again

PLEASE HELP MACRO NEEDED
 

On 27 Apr, 10:30, K wrote:
On 26 Apr, 02:15, Phillip wrote:





On 24 Apr, 22:13, K wrote:

Please see the post below

http://groups.google.co.uk/group/mic....programming/b....

if anybody cannot understand my question in above post please see my
excel sheet which i have uploaded on "savefile.com" and put the link
below to see that file. i have explained more clearly what i want.
Please please if anybody can help

FILE LINK (see below)

http://www.savefile.com/files/1521549

Phillip London UK

This works for me
Paste the following code into a standard module

Sub DoReport()
* * DoCalcs Sheet1.Range("A3:A14"), "GX", Sheet2.Range("B1"), False
* * DoCalcs Sheet1.Range("B3:B14"), "GT", Sheet2.Range("B2"), True
End Sub

Private Sub DoCalcs(Rg As Range, Cde As String, Multi As Long, flag As
Boolean)
* * Dim cl As Range
* * Dim startcell As Range
* * Dim total As Long
* * Dim roundamount As Long
* * Dim adjust As Long
* * Dim curcell As Range
* * Static oset As Long
* * Set startcell = Sheet3.Range("A2")
* * For Each cl In Rg
* * * * startcell.Offset(oset, 0).Value = Cde
* * * * roundamount = WorksheetFunction.Round((cl.Value / 100) *
Multi, 0)
* * * * startcell.Offset(oset, 1).Value = roundamount
* * * * If roundamount = 1 Then
* * * * Set curcell = startcell.Offset(oset, 1)
* * * * End If
* * * * oset = oset + 1
* * * * total = total + roundamount
* * Next
* * adjust = Multi - total
* * curcell.Value = curcell.Value + adjust
* * If flag Then oset = 0
End Sub

Thanks Philip for replying. *i havnt tried your macro yet but i'll go
to office on Monday and will try your code and let you know if i have
any question. *Thanks again- Hide quoted text -

- Show quoted text -

Thanks man it works superb