PLEASE HELP MACRO NEEDED

[K]

Please see the post below

http://groups.google.co.uk/group/mi.../browse_thread/thread/d812923e8faf5664?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

 

[Phillip]

Please see the post below

http://groups.google.co.uk/group/microsoft.public.excel.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

 

[K]

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

 

[K]

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