VBA loop to distribute value among cells

[GE2]

I need to fill in columns to the right of D & E for each row. The number of columns used will be the number in column E. The sum of the numbers in those new columns for each row will be the number in column D. The catch is that I need to distribute the numbers as evenly as possible, meaning can’t just divide column D by column E and then put the remainder in the last column. It’s more like counting out one to each column until the total in column D is reached. For example, in row 3, there would be 6 columns used, F through K. The values in those cells F3 through K3 would be 6, 6, 6, 6, 5, 5. Thanks in advance!

 

[GWteB]

Hi & Welcome to MrExcel!

If you agree with a UDF then this might be a solution for you. Note that it's an array function (aka CSE function) which must be entered with Ctrl Shift Enter.
If the used worksheet range is larger than the distribution number, the function returns a 0. If desired, such cells can be easily masked using conditional formatting.

Public Function Distribute(ByVal argValue As Long, ByVal argAmount As Long) As Long()

    Dim m As Long, t As Long, arr() As Long, i As Long, n As Long

    m = argValue Mod argAmount
    t = (argValue + (argAmount - m)) / argAmount
    ReDim arr(1 To 16384)
    For i = 1 To m
        arr(i) = t
    Next i
    For n = i To argAmount
        arr(n) = t - 1
    Next n
    Distribute = arr
End Function

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1
2		34	6	6	6	6	6	5	5	0	0	0	0
3		29	5	6	6	6	6	5	0	0	0	0	0
4		36	8	5	5	5	5	4	4	4	4	0	0
5		22	4	6	6	5	5	0	0	0	0	0	0
6
Sheet1

Cell Formulas
Range	Formula
D2:M5	D2	=Distribute(B2,C2)
Press CTRL+SHIFT+ENTER to enter array formulas.

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
D2:M5	Cell Value	=0	text	NO

 

[Marc L]

A VBA demonstration for starters :​

Sub Demo1()
        Dim V, R&, L&
        Application.ScreenUpdating = False
    With [D3].CurrentRegion
            V = .Value2
        For R = 1 To .Rows.Count
            If V(R, 2) > 1 Then
                L = Round(V(R, 1) / V(R, 2), 0)
               .Cells(R, 3).Resize(, V(R, 2) - 1).Value2 = L
               .Cells(R, 3)(1, V(R, 2)).Value2 = V(R, 1) - L * (V(R, 2) - 1)
            End If
        Next
    End With
        Application.ScreenUpdating = True
End Sub

 

[Marc L]

As I missed the part « The values in those cells F3 through K3 would be 6, 6, 6, 6, 5, 5 » another VBA demonstration :​

Sub Demo2()
        Dim V, R&, N&(), C%
        Application.ScreenUpdating = False
    With [D3].CurrentRegion
            V = .Value2
        For R = 1 To .Rows.Count
            If V(R, 2) > 0 Then
                ReDim N(1 To V(R, 2))
            For C = V(R, 2) To 1 Step -1
                N(C) = V(R, 1) \ C
                V(R, 1) = V(R, 1) - N(C)
            Next
               .Cells(R, 3).Resize(, V(R, 2)).Value2 = N
            End If
        Next
    End With
        Application.ScreenUpdating = True
End Sub

 

[Rick Rothstein]

Put this formula in cell F3 and copy it across for as many cells as the largest number you ever expect to be in a Column E...

=IF(COLUMNS($F:F)>$E3,"",INT($D3/$E3)+(COLUMNS($F:F)<=$D3-$E3*INT($D3/$E3)))