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