View Single Post
 
Old 08-08-2025, 12:08 PM
p45cal's Avatar
p45cal p45cal is offline Windows 10 Office 2021
Expert
 
Join Date: Apr 2014
Posts: 956
p45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond repute
Default

This is specific for 5 chosen out of 6 possibles:
Code:
Sub blah()
x = "ABCDEF"
y = Len(x)
Count = Application.WorksheetFunction.Permut(y, 5)
Set Destn = ActiveCell
ReDim Results(1 To Count, 1 To 1)
idx = 0
ReDim result(1 To 5)
For a = 1 To y
  result(1) = Mid(x, a, 1)
  For b = 1 To y
    If b <> a Then
      result(2) = Mid(x, b, 1)
      For c = 1 To y
        If c <> a And c <> b Then
          result(3) = Mid(x, c, 1)
          For d = 1 To y
            If d <> a And d <> b And d <> c Then
              result(4) = Mid(x, d, 1)
              For e = 1 To y
                If e <> a And e <> b And e <> c And e <> d Then
                  result(5) = Mid(x, e, 1)
                  idx = idx + 1
                  Results(idx, 1) = Join(result, "")
                End If
              Next e
            End If
          Next d
        End If
      Next c
    End If
  Next b
Next a
Destn.Resize(idx) = Results
End Sub
It's clunky but it should run fast. Results are output to the active cell and the 719 cells below it.
Reply With Quote