Sub Spread()
'
'Initialize Variables
iRow = 4 'This is the ROW you want to spread across
d = InputBox("Please Enter The Number of Days You Need to Spread")
x = Cells(4, 7) 'Put in the AMOUNT here
'
'Get the nearest integer to spread across all the days
iNearest = Int(x / d)
For iCol = 68 To d + 67
Cells(iRow, iCol).Value = iNearest
Next iCol
'
'Now use a random number generator to get rid of the "leftovers"
iLeftOver = x - d * iNearest
For i = 1 To iLeftOver
' Make sure the same cell doesn't get hit twice
Do
fRandom = Int((d * Rnd(i)) + 1)
Loop Until Cells(iRow, fRandom + 67) = iNearest
Cells(iRow, fRandom + 67) = Cells(iRow, fRandom + 67) + 1
Next i
End Sub
Sub Spread()
'
'Initialize Variables
d = InputBox("Please Enter The Number of Days You Need to Spread")
RwCnt = Cells(Rows.Count, 7).End(xlUp).Row
For iRow = 3 To RwCnt 'This is the ROWs you want to spread across
' iRow = 4
x = Cells(iRow, 7) 'Put in the AMOUNT here
'
'Get the nearest integer to spread across all the days
iNearest = Int(x / d)
For iCol = 68 To d + 67
Cells(iRow, iCol).Value = iNearest
Next iCol
'
'Now use a random number generator to get rid of the "leftovers"
iLeftOver = x - d * iNearest
For i = 1 To iLeftOver
' Make sure the same cell doesn't get hit twice
Do
fRandom = Int((d * Rnd(i)) + 1)
Loop Until Cells(iRow, fRandom + 67) = iNearest
Cells(iRow, fRandom + 67) = Cells(iRow, fRandom + 67) + 1
Next i
Next iRow
End Sub
If you are experiencing a similar issue, please ask a related question
Join the community of 500,000 technology professionals and ask your questions.