Randomly fill cells with user-entered text

I think a macro will do the trick, but I am not experienced enough to write one up. Here's what I'm looking for.

Variables: Need a pop-up box to enter any number of text strings (DATA1, DATA2, DATA3, etc.) and another pop-up box to enter a percentage in numeral form (PERCENTAGE1, PERCENTAGE2, PERCENTAGE3, etc.) There has to be a PERCENTAGE variable for every DATA variable and the sum of all the PERCENTAGE variables must equal 100 exactly.

Execution: The macro will randomly fill cells E3:E1002 with each DATA string. The number of cells filled will be equal to the PERCENTAGE multiplied by 10 entered for each DATA string. (NOTE: The PERCENTAGE number is multiplied by 10 because there are exactly 1,000 cells to be filled. This range of cells will never change.)

For example, we have the following entered by the user at the opening of the workbook.

DATA1 = Apple - PERCENTAGE1 = 65
DATA2 = Ball - PERCENTAGE2 = 26
DATA3 = Cat - PERCENTAGE3 = 9

Based on this user-entered information, the macro would determine the sum of the PERCENTAGE values does equal 100 then would randomly fill "Apple" into 650 (PERCENTAGE1 X 10) empty cells between E3:E1002. Then, it would fill "Ball" into 260 of the remaining empty cells in the range E3:E1002 and finally fill "Cat" into the remaining 90 empty cells within that range.

Ideally, the macro would sum the PERCENTAGE values and return an error message if the sum does not exactly equal 100. Also, since the number of DATA strings is not constant, there would have to be a way to tell the macro the user if finished entering DATA strings. Perhaps the user entering an empty DATA string, or something similar.

This seem feasible? Doesn't sound too complicated for an advanced VBA writer, but I'm just not that talented.

THANKS IN ADVANCE!

Not really used random numbers much before, but had a go at this. See attached. I put the values in cells A1:B3, and used a smaller range of 50 cells, but you get the idea. Might be easier anyway than input boxes.

Sub x()

Dim i As Long, rng As Range, r As Long, p As Long

Columns(5).ClearContents
p = 50
Set rng = Range("E3").Resize(p)
Randomize
For i = 1 To Range("A1").End(xlDown).Row - 1
    Do While WorksheetFunction.CountIf(rng, Cells(i, 1)) < p * Cells(i, 2) / 100
        r = Int(Rnd * p) + 1
        If rng(r) = vbNullString Then rng(r) = Cells(i, 1)
    Loop
Next i
rng.SpecialCells(xlCellTypeBlanks) = Cells(Range("A1").End(xlDown).Row, 1)

End Sub

The code works as advertised, which is AWESOME! Now I need a few tweaks if possible.

1) Any way to move the variables from A1:B3 to some cells farther right? Say H6:I8?

2) Could we add to the code a command to make the macro run when any of the variable cells are changed?

3) Any way to make the macro check to see if the numbers add up to 100 instead of automatically filling the remaining cells with whatever it takes?

That should just about finish off the sheet and make it do exactly what I want.

THANKS!

Try this:

Sub x()

Dim rInp As Range, rOut As Range, i As Long, nVal As Long, nSize As Long

nSize = 50
Set rOut = Range("E3").Resize(nSize)
Set rInp = Range("H6", Range("H6").End(xlDown)).Resize(, 2)

If WorksheetFunction.Sum(rInp.Columns(2)) <> 100 Then
    MsgBox "Must add to 100%"
    Exit Sub
End If

Application.ScreenUpdating = False

Columns(5).ClearContents

Randomize

For i = 1 To rInp.Rows.Count - 1
    Do While WorksheetFunction.CountIf(rOut, rInp(i, 1)) < nSize * rInp(i, 2) / 100
        nVal = Int(Rnd * nSize) + 1
        If rOut(nVal) = vbNullString Then rOut(nVal) = rInp(i, 1)
    Loop
Next i

rOut.SpecialCells(xlCellTypeBlanks) = rInp(rInp.Rows.Count, 1)

Application.ScreenUpdating = True

End Sub

If you want it to run automatically you need this in the sheet module. This will run whenever anything in col H or I is changed as I don't know how large your range will be. FWIW I think it would be better to stick with a button.

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 8 Or Target.Column = 9 Then x

End Sub

That's exactly what I needed Stephen. THANK YOU!

BTW, I did decide to stay with the button.