Microsoft Excel

[Nick Vaughn]

Can anyone help me out on this one. I would like to have a formula for Subsets.

 

[Ruddles]

4-character combinations, no repeated characters:-

[FONT=Fixedsys]Option Explicit[/FONT]
 
[FONT=Fixedsys]Sub CombineAtoZx4_NoR()[/FONT]
 
[FONT=Fixedsys]  Dim ws As Worksheet
  Dim n1 As Integer, n2 As Integer, n3 As Integer, n4 As Integer
  Dim iRow As Long, iColumn As Long, iCombinations As Long
  Dim dStart As Date
  
  Application.StatusBar = ""
  Application.ScreenUpdating = False
  
  dStart = Now()
  
  Set ws = ThisWorkbook.Sheets(1)
  ws.UsedRange.ClearContents
  
  iCombinations = 0
  iRow = 0
  iColumn = 1[/FONT]

[FONT=Fixedsys]  For n1 = Asc("A") To Asc("W")
    For n2 = n1 + 1 To Asc("X")
      For n3 = n2 + 1 To Asc("Y")
        For n4 = n3 + 1 To Asc("Z")
          iRow = iRow + 1
          If iRow > 2000 Then
            ws.Columns(iColumn).EntireColumn.AutoFit
            iColumn = iColumn + 1
            iRow = 1
            Application.StatusBar = Format(iCombinations, "#,###") & " combinations found in " _
                & Format(Now() - dStart, "hh:nn:ss")
            Application.ScreenUpdating = False
            Application.ScreenUpdating = True
         End If
          ws.Cells(iRow, iColumn) = Chr(n1) & Chr(n2) & Chr(n3) & Chr(n4)
          iCombinations = iCombinations + 1
        Next n4
      Next n3
    Next n2
  Next n1
  
  ws.Columns(iColumn).EntireColumn.AutoFit
  
  Application.ScreenUpdating = True
  
  MsgBox Format(iCombinations, "#,###") & " combinations found" & Space(10) & vbCrLf & vbCrLf _
       & "Run time: " & Format(Now() - dStart, "hh:nn:ss"), vbOKOnly + vbInformation[/FONT]
 
[FONT=Fixedsys]End Sub
[/FONT]

I really must be more precise when talking about combinations and permutations. When order matters, they're permutations; when it doesn't they're combinations.

So combination locks should really be called permutation locks!

 

[Nick Vaughn]

Hey Mr. Ruddles,

This was exactly what I was looking for; you’ve been a great help. Thank you.

Question: Given that (A-Z) is 26 characters; would any 26 character numbers work in the place of letters. Example (1-26).

Is it is possible; can you send it over so I can take a look at it.

 

[Ruddles]

Not with that code because "26" is two characters and the routine works by combining each possible single character from A to Z in the first position with each possible single character from A to Z in the second position with each possible single character from A to Z in the third position with each possible single character from A to Z in the fourth position.

Any 26 single characters would work, for example "°µ»½½¾ÂÇËÏÑÕØÞáæìñ÷þąĎĐÿĘğ", but they'd have to be single characters.

But anything's possible. Describe what you're trying to achieve - what the desired output will look like.

 

[Nick Vaughn]

Generally looking for sets Numbers as the need arise for my clients without the exact matching characters. Similar to what we’ve accomplished with the letter.

Range Example 1 : 1 ,2, 3, 4 ,5,6
= (1,2,3,4), (1,2,3,5),(1,2,3,6)
= (2,3,4,5),(2,3,4,6)
= (3, 4 ,5,6),

Range Example 2: 10, 11, 12, 13, 14, 15.
= (10,11,12,13), (10,11,12,14), (10,11,12,15).
= (11,12,13,14), (11,12,13,15).
= (12,13,14,15).

 

[Nick Vaughn]

I tried changing A-Z letter range to 1-26 number range since it is the same amount of characters but doing some research I saw that Chr return letters. I thought it was simple as changing Chr; allowing it to generate just as the letter did.

 

[Ruddles]

Try this:

[FONT=Fixedsys]Option Explicit[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]Sub CombineNumericX4()[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]  Const StartNumber As Long = 10
  Const LastNumber As Long = 26[/FONT]
[FONT=Fixedsys]
  Const MaxRows As Long = 10000
  
  Dim ws As Worksheet
  Dim n1 As Integer, n2 As Integer, n3 As Integer, n4 As Integer
  Dim iRow As Long, iColumn As Long, iCombinations As Long
  Dim dStart As Date
  
  Application.StatusBar = ""
  Application.ScreenUpdating = False
  
  dStart = Now()
  
  Set ws = ThisWorkbook.Sheets(3)
  ws.UsedRange.ClearContents
  
  iCombinations = 0
  iRow = 0
  iColumn = 1
  For n1 = StartNumber To LastNumber - 3
    For n2 = n1 + 1 To LastNumber - 2
      For n3 = n2 + 1 To LastNumber - 1
        For n4 = n3 + 1 To LastNumber
          iRow = iRow + 1
          If iRow > MaxRows Then
            ws.Columns(iColumn).EntireColumn.AutoFit
            iColumn = iColumn + 1
            iRow = 1
            Application.StatusBar = Format(iCombinations, "#,###") & " combinations found in " _
                & Format(Now() - dStart, "hh:nn:ss")
            Application.ScreenUpdating = False
            Application.ScreenUpdating = True
         End If
          ws.Cells(iRow, iColumn) = CStr(n1) & "," & CStr(n2) & "," & CStr(n3) & "," & CStr(n4)
          iCombinations = iCombinations + 1
        Next n4
      Next n3
    Next n2
  Next n1
  
  ws.Columns(iColumn).EntireColumn.AutoFit
  
  Application.ScreenUpdating = True
  
  MsgBox Format(iCombinations, "#,###") & " combinations found" & Space(10) & vbCrLf & vbCrLf _
       & "Run time: " & Format(Now() - dStart, "hh:nn:ss"), vbOKOnly + vbInformation
[/FONT] 
[FONT=Fixedsys]End Sub[/FONT][FONT=Fixedsys]
[/FONT]

Change StartNumber and LastNumber to 1 & 6 or 10 & 15 to generate the sequences you describe.

Is that what you were after?

 

[Nick Vaughn]

Yes this looks good.