Distribute rows equally & roundup function mess

[oli_g]

Hi guys,
I have digging around this one for a while now, let me explain. I am trying to split a list according to the amount of people available on this day. So in my sheet I have X number of rows and Z number of person. X/Z will give me the amount of rows by person, easy, it works fine (the final goal is to color each block of row for each people).

My issue is the following : Let say I have 24 rows and 10 people, the roundup function gives me 2 rows by person, and I get 10 times 2 row = 20 rows, how to distribute the last missing 4 rows ?
My idea would be to have 8 x 2rows + 2 x 4rows = 24 rows
I cannot figure out the mathematic way to handle this case.

i have included my code below (I define staff and TotalRows, and it colors the rows accordingly)

* All my datas are entered in Col A, from cell A5, that's why I have a firstrow=5

Private Sub AutoSplit_Click()
firstRow = 1
staff = 10
TotalRows = 24

rwsPerStaff = WorksheetFunction.Round(TotalRows / staff, 0) 'determine the number of rows per staff
For i = 1 To staff
rwstart = firstRow + (i - 1) * rwsPerStaff
rwend = rwstart + rwsPerStaff - 1
Worksheets("Sheet1").Range("A" & rwstart & ":D" & rwstart + rwsPerStaff - 1).Select
Selection.Interior.ColorIndex = i + 33
Next
Debug.Print (TotalRows + firstRow - 1)

If rwend < (TotalRows + firstRow - 1) Then
Worksheets("Sheet1").Range("A" & rwend + 1 & ":D" & (TotalRows + firstRow - 1)).Select
Selection.Interior.ColorIndex = i + 33 - 1
End If

If rwend > (TotalRows + firstRow - 1) Then
Worksheets("Sheet1").Range("A" & rwend + 1 & ":D" & (TotalRows + firstRow)).Select
Selection.Interior.ColorIndex = none
End If

End Sub

Thanks for your help !
Oli

[patel45]

can you attach a sample file with data and desired output ?

[HaHoBe]

Hi, oli_g,

maybe have a look at this code:

Private Sub AutoSplit_Click()
Dim lngSupRows      As Long
Dim lngHelp         As Long
Dim lngRwsPerStaff  As Long
Dim lngRwStart      As Long
Dim lngRwEnd        As Long
Dim lngRC           As Long

Const clngSTAFF As Long = 10
Const clngTOTAL_ROWS As Long = 24

lngRwsPerStaff = WorksheetFunction.RoundDown(clngTOTAL_ROWS / clngSTAFF, 0) 'determine the number of rows per staff

lngSupRows = clngTOTAL_ROWS - lngRwsPerStaff * clngSTAFF
lngRwStart = 5

For lngRC = 1 To clngSTAFF
  With Worksheets("Sheet1")
    If lngRC <= lngSupRows Then
      lngHelp = 1
    Else
      lngHelp = 0
    End If
    lngRwEnd = lngRwStart + lngRwsPerStaff - 1 + lngHelp
    With .Range("A" & lngRwStart & ":D" & lngRwEnd)
      If lngRC Mod 2 = 1 Then
        .Interior.ColorIndex = lngRC + 33 - 1
      Else
        .Interior.ColorIndex = xlNone
      End If
    End With
  End With
  lngRwStart = lngRwEnd + 1
Next lngRC
End Sub

Ciao,
Holger

[oli_g]

Awesome Holger, that's exactly what I was looking for.
Thanks for the quick answer (and the clean code)