Distribute Numbers

Hi,

How can I distribute 1 numbers for each cell when the maximum Last row is met and need to go back to 1?

I have 7 numbers, need it to distribute in 5 persons.

People 1 = 1
People 2 = 1
People 3 = 1
People 4 = 1
People 5 = 1

Now need to go back to People 1 to add 1 then People 2 to add 1 also.

People 1 = 2
People 2 = 2
People 3 = 1
People 4 = 1
People 5 = 1

How can I do this in a VBA macro distributing numbers,

Output of the spreadsheet will be this:

	A	B
1	People 1	2
2	People 2	2
3	People 3	1
4	People 4	1
5	People 5	1

You should be able to do this without a macro. If your people are listed in column A and your magic number (7) is in D1, then paste the formula below in B1 and fill down through B5:

=INT($D$1/COUNTA($A$1:$A1000))+IF(ROW()<=MOD($D$1,COUNTA($A$1:$A1000)),1,0)

Using a formula will give you automatic updates if you need to change your magic number.

Try this for names in "A".
Change Constant "Num" to suit.

Sub MG23Jun41
Dim Lst As Long, c As Long, Rw As Long
Const num As Integer = 7
Lst = Range("A" & Rows.Count).End(xlUp).Row
Do Until c = num
    c = c + 1: Rw = Rw + 1
    Cells(Rw, 2) = Cells(Rw, 2) + 1
    Rw = IIf(Rw Mod Lst = 0, 0, Rw)
Loop
End Sub

Regards Mick

To: MickG

Im getting an error:

"Application defined or object defined"

I just need to tweak the code in my need.

The Names are listed in Column I. It has 5 names. Then I have a value that needs to be divided to them 5. Thats why I need a code, would just like to ask some more help on my errors, here is my code.

Sub MG23Jun41
Dim Lst As Long, c As Long, Rw As Long

Dim num As Integer

Rw = 6 'This is the start of RowNumber (optional for B2 on sample)
Lst = Range("I" & Rows.Count).End(xlUp).Row 'The EndRow where it shoulf be placed (optional for B5 on sample)
num = Range("E2").Value 'This is the number of items I need to equally distribute to each People

Do Until c = num
    
    Cells(Rw, 8) = Cells(Rw, 8) + 1 'This is where the line error is
    c = c + 1: Rw = Rw + 1
    Rw = IIf(Rw Mod Lst = 0, 0, Rw) 'What is this code does? Not familiar
Loop

End Sub

To: MickG

Im getting an error:

"Application defined or object defined"

I just need to tweak the code in my need.

The Names are listed in Column I. It has 5 names. Then I have a value that needs to be divided to them 5. Thats why I need a code, would just like to ask some more help on my errors, here is my code.

Sub MG23Jun41
Dim Lst As Long, c As Long, Rw As Long

Dim num As Integer

Rw = 6 'This is the start of RowNumber (optional for B2 on sample)
Lst = Range("I" & Rows.Count).End(xlUp).Row 'The EndRow where it shoulf be placed (optional for B5 on sample)
num = Range("E2").Value 'This is the number of items I need to equally distribute to each People

Do Until c = num
    
    Cells(Rw, 8) = Cells(Rw, 8) + 1 'This is where the line error is
    c = c + 1: Rw = Rw + 1
    Rw = IIf(Rw Mod Lst = 0, 0, Rw) 'What is this code does? Not familiar
Loop

End Sub

If you data is basically like this:-

Row No  Col(H)  Col(I)   
1.                       
2.                       
3.                       
4.                       
5.                       
6.      2       people 1 
7.      2       people 2 
8.      1       people 3 
9.      1       people 4 
10.     1       people 5

Then this is the code:-

Sub MG23Jun15
Dim Lst As Long, c As Long, Rw As Long
Dim num As Integer
Rw = 5 'This is the start of RowNumber (optional for B2 on sample)
Lst = Range("I" & Rows.Count).End(xlUp).Row 'The EndRow where it shoulf be placed (optional for B5 on sample)
num = Range("E2").Value 'This is the number of items I need to equally distribute to each People

Do Until c = num
    c = c + 1: Rw = Rw + 1
    Cells(Rw, 8) = Cells(Rw, 8) + 1 'This is where the line error is
    Rw = IIf(Rw Mod Lst = 0, 5, Rw) 'What is this code does? Not familiar
Loop

End Sub

Regards Mick

If you data is basically like this:-

      Col(H)   Col(I)
1.                       
2.                       
3.                       
4.                       
5.                       
6.      2       people 1 
7.      2       people 2 
8.      1       people 3 
9.      1       people 4 
10.     1       people 5

Then this is the code:-

Sub MG23Jun15
Dim Lst As Long, c As Long, Rw As Long
Dim num As Integer
Rw = 5 'This is the start of RowNumber (optional for B2 on sample)
Lst = Range("I" & Rows.Count).End(xlUp).Row 'The EndRow where it shoulf be placed (optional for B5 on sample)
num = Range("E2").Value 'This is the number of items I need to equally distribute to each People

Do Until c = num
    c = c + 1: Rw = Rw + 1
    Cells(Rw, 8) = Cells(Rw, 8) + 1 'This is where the line error is
    Rw = IIf(Rw Mod Lst = 0, 5, Rw) 'What is this code does? Not familiar
Loop

End Sub

Regards Mick

It was so amazing.. Now works fine for me! Thank you so much.. that was exactly I am looking for. Thank you.

You're welcome