I was just wondering if it would be possible to have a macro take the values
of a set of cells/ranges (say A1 thru A5) and have Column C Filled with as
many random combinations of those values strung together in say.... 200
permutations?

Generally I'm thinking of applying this to generating random Hex or Binary
strings or just Gibberish Sentences.

Well, if it's possible would you please help.


Thanks In Advance,
Rob

Hi Rob,

With the following code you can enter words in column A for as many cells as
you like starting from cell A1.

The code first asks how many words to include in each cell of the output.
(Default is 6)
It then asks how many cells of output required. (Default is 200)

It does not repeat any random string.

If the code has difficulty creating the number of unique random strings due
to either too few words or too many cells of output then the processing
aborts.

Because the code uses the RANDBETWEEN function you need the analaysis tool
pak addin loaded. This is a standard Excel feature. See Addins in help to
find out how to load it. (If you have a problem with this then let me know
what version of xl you are using.)


Sub RandomFromList()

Dim rngList As Range
Dim lngNumbInCell As Long
Dim lngNumbOfCells As Long
Dim lngCellLast As Long
Dim lngCountDuplicates As Long
Dim strTemp As String
Dim i As Long
Dim j As Long

lngNumbInCell = Application.InputBox _
(prompt:="Enter the number of words in each cell", _
Title:="Number of words in each cell", _
Default:=6, Type:=1)

lngNumbOfCells = Application.InputBox _
(prompt:="Enter the number of cells required", _
Title:="Number of cells to fill", _
Default:=200, Type:=1)

'Edit the sheet name to match required sheet
With Sheets("Sheet1")
Set rngList = .Range(.Cells(1, 1), _
Cells(.Rows.Count, 1).End(xlUp))

lngCellLast = rngList.Rows.Count

For i = 1 To lngNumbOfCells
lngCountDuplicates = 0

CreateRandStr:
strTemp = ""
For j = 1 To lngNumbInCell
strTemp = strTemp & " " & _
rngList.Cells(WorksheetFunction _
.RandBetween(1, lngCellLast))
Next j

'Test for existing random string
If WorksheetFunction.CountIf(.Columns("C:C"), _
"=" & strTemp) = 0 Then

'Add string if not yet existing
.Cells(i, "C") = strTemp
Else
lngCountDuplicates = lngCountDuplicates + 1

'Abort processing if cannot create required
'number of random strings
If lngCountDuplicates 10 Then
MsgBox "insufficient options to create " _
& lngNumbOfCells & " random strings" _
& vbCrLf & "Processing will terminate"
Exit Sub
End If

GoTo CreateRandStr
End If
Next i
End With
End Sub

--
Regards,

OssieMac

Holy.......!! That's perfect! Thanks Very Much!



"OssieMac" wrote:

Hi Rob,

With the following code you can enter words in column A for as many cells as
you like starting from cell A1.

The code first asks how many words to include in each cell of the output.
(Default is 6)
It then asks how many cells of output required. (Default is 200)

It does not repeat any random string.

If the code has difficulty creating the number of unique random strings due
to either too few words or too many cells of output then the processing
aborts.

Because the code uses the RANDBETWEEN function you need the analaysis tool
pak addin loaded. This is a standard Excel feature. See Addins in help to
find out how to load it. (If you have a problem with this then let me know
what version of xl you are using.)


Sub RandomFromList()

Dim rngList As Range
Dim lngNumbInCell As Long
Dim lngNumbOfCells As Long
Dim lngCellLast As Long
Dim lngCountDuplicates As Long
Dim strTemp As String
Dim i As Long
Dim j As Long

lngNumbInCell = Application.InputBox _
(prompt:="Enter the number of words in each cell", _
Title:="Number of words in each cell", _
Default:=6, Type:=1)

lngNumbOfCells = Application.InputBox _
(prompt:="Enter the number of cells required", _
Title:="Number of cells to fill", _
Default:=200, Type:=1)

'Edit the sheet name to match required sheet
With Sheets("Sheet1")
Set rngList = .Range(.Cells(1, 1), _
Cells(.Rows.Count, 1).End(xlUp))

lngCellLast = rngList.Rows.Count

For i = 1 To lngNumbOfCells
lngCountDuplicates = 0

CreateRandStr:
strTemp = ""
For j = 1 To lngNumbInCell
strTemp = strTemp & " " & _
rngList.Cells(WorksheetFunction _
.RandBetween(1, lngCellLast))
Next j

'Test for existing random string
If WorksheetFunction.CountIf(.Columns("C:C"), _
"=" & strTemp) = 0 Then

'Add string if not yet existing
.Cells(i, "C") = strTemp
Else
lngCountDuplicates = lngCountDuplicates + 1

'Abort processing if cannot create required
'number of random strings
If lngCountDuplicates 10 Then
MsgBox "insufficient options to create " _
& lngNumbOfCells & " random strings" _
& vbCrLf & "Processing will terminate"
Exit Sub
End If

GoTo CreateRandStr
End If
Next i
End With
End Sub

--
Regards,

OssieMac