Randomly Rearrange Letters in a Word to Provide a List of 100 Rearrangements

[rwmill9716]

I need a macro that will take a word that I supply in Cell A1 then randomly rearrange its letters 100 times supplying those rearrangements in Cells B1 to B100. Note, the initial word can vary in length, and every letter needs to be used without replacement. As an example, when I put heritage in A1, it might come back with gtaerieh in B1 and others in B2 to B100.

 

[DanteAmor]

Try this:

Sub RandomWord()
  Dim n As Long, i As Long, j As Long, k As Long, x As Long, y As Long
  Dim arr As Variant
  Dim vle As String, cad As String
  
  vle = Range("A1").Value
  n = Len(vle)
  arr = Evaluate("=ROW(1:" & n & ")")
  
  For j = 1 To 100
    For i = 1 To UBound(arr)
      x = Int(UBound(arr) * Rnd + 1)
      y = arr(x, 1)
      arr(x, 1) = arr(i, 1)
      arr(i, 1) = y
    Next
    cad = ""
    For k = 1 To UBound(arr)
      cad = cad & Mid(vle, arr(k, 1), 1)
    Next
    Range("B" & j).Value = cad
  Next
End Sub

 

[rwmill9716]

Try this:

Sub RandomWord()
  Dim n As Long, i As Long, j As Long, k As Long, x As Long, y As Long
  Dim arr As Variant
  Dim vle As String, cad As String
 
  vle = Range("A1").Value
  n = Len(vle)
  arr = Evaluate("=ROW(1:" & n & ")")
 
  For j = 1 To 100
    For i = 1 To UBound(arr)
      x = Int(UBound(arr) * Rnd + 1)
      y = arr(x, 1)
      arr(x, 1) = arr(i, 1)
      arr(i, 1) = y
    Next
    cad = ""
    For k = 1 To UBound(arr)
      cad = cad & Mid(vle, arr(k, 1), 1)
    Next
    Range("B" & j).Value = cad
  Next
End Sub

DanteAmor, your macro works great. One more question: is there a formula (or macro) that I could use in Col C that would identify as to whether its Colm B member is an English word or just gibberish? I

 

[JGordon11]

I need a macro that will take a word that I supply in Cell A1 then randomly rearrange its letters 100 times supplying those rearrangements in Cells B1 to B100. Note, the initial word can vary in length, and every letter needs to be used without replacement. As an example, when I put heritage in A1, it might come back with gtaerieh in B1 and others in B2 to B100.

In 365 can be done with a formula

Book2
	A	B
1	heritage	getaiher
2		airhgete
3		eihgtrae
4		aeehgrti
5		tgirehea
6		ehtrgeia
7		eegahtir
8		gthierea
9		iahgeter
10		ihgetaer
Sheet1

Cell Formulas
Range	Formula
B1:B10	B1	=LET(l,LEN(A$1),r,RANDARRAY(l),s,MATCH(SMALL(r,SEQUENCE(l)),r,0), TEXTJOIN("",1,MID(A$1,s,1)))

 

[DanteAmor]

is there a formula (or macro) that I could use in Col C that would identify as to whether its Colm B member is an English word or just gibberish?

Try this:

Sub RandomWord()
  Dim n As Long, i As Long, j As Long, k As Long, x As Long, y As Long
  Dim arr As Variant, b As Variant
  Dim vle As String, cad As String
  Dim boo As Boolean
  
  vle = Range("A1").Value
  n = Len(vle)
  arr = Evaluate("=ROW(1:" & n & ")")
  ReDim b(1 To 100, 1 To 2)
  
  For j = 1 To 100
    For i = 1 To UBound(arr)
      x = Int(UBound(arr) * Rnd + 1)
      y = arr(x, 1)
      arr(x, 1) = arr(i, 1)
      arr(i, 1) = y
    Next
    cad = ""
    For k = 1 To UBound(arr)
      cad = cad & Mid(vle, arr(k, 1), 1)
    Next
    b(j, 1) = cad
    If Application.CheckSpelling(cad) Then
      b(j, 2) = "English word"
    Else
      b(j, 2) = "Gibberish"
    End If
  Next

  Range("B1").Resize(UBound(b, 1), 2).Value = b
End Sub

 

[rwmill9716]

Your program encountered a problem as shown in yellow.

 

[rwmill9716]

Try this:

Sub RandomWord()
  Dim n As Long, i As Long, j As Long, k As Long, x As Long, y As Long
  Dim arr As Variant, b As Variant
  Dim vle As String, cad As String
  Dim boo As Boolean
 
  vle = Range("A1").Value
  n = Len(vle)
  arr = Evaluate("=ROW(1:" & n & ")")
  ReDim b(1 To 100, 1 To 2)
 
  For j = 1 To 100
    For i = 1 To UBound(arr)
      x = Int(UBound(arr) * Rnd + 1)
      y = arr(x, 1)
      arr(x, 1) = arr(i, 1)
      arr(i, 1) = y
    Next
    cad = ""
    For k = 1 To UBound(arr)
      cad = cad & Mid(vle, arr(k, 1), 1)
    Next
    b(j, 1) = cad
    If Application.CheckSpelling(cad) Then
      b(j, 2) = "English word"
    Else
      b(j, 2) = "Gibberish"
    End If
  Next

  Range("B1").Resize(UBound(b, 1), 2).Value = b
End Sub

Thanks, Dante Amor, this works well.

 

[DanteAmor]

Im glad to help you, thanks for the feedback.