Distribute Cell Value to adjacent Cells


I want to distribute value of a cell into different cells.

e.g. For 200 I want it to be distributed into 4 cells of 50 each and for 120 it should have 2 cells of 50 and one cell of 20

My data is attached. 

When I created a macro the value in the last cell also comes as 50 whereas it should have only the remaining value

Sub macro2()
Dim z
Do While ActiveCell.Value < 2000
z = ActiveCell.Value / 50
Dim result As Integer
result = Round(z, o)
If result < z Then
    result = result + 1
    End If
ActiveCell.Offset(0, 2).Value = result
If z = 1 Then GoTo jump
If z >= 2 Then
z = z - 1
End If
If ActiveCell.Value < 50 Then GoTo last
For i = 1 To result - 1
Rows(ActiveCell.Row + i).Insert
ActiveCell.Offset(i - 1, 1).Value = 50
Next i
ActiveCell.Offset(i - 1, 1).Value = 50
ActiveCell.Offset(1, 0).Select
End Sub

Thanks in advance for the help




 Why not just try a formula like this:


This assumes the number starts in cell A1. Copy the formula to the right of each number and then down for the entire list.

This puts the numbers to the right of the original number but it should work better and without having to use a macro.



This is for greeting cards and a packet can have 50 greeting cards at the max.

I need it to automatically insert rows so that if the value is 220 it is distributed in 5 rows of 50,50,50,50,20
vipul73 Jan 11, '17 at 4:41 am
And I'm asking why it needs to be in rows? The formula method will be a lot easier to manage and implement, but it will put it in columns.
don (rep: 1247) Jan 12, '17 at 1:08 am
Add to Discussion

Answer the Question

You must create an account to use the forum. Create an Account or Login