Combinations

you said the only #s would be 1-9. having 0 excluded would drop the number of answers severely. you are correct if you can use 0s though.
not that either.

XX,XXX is 5 digits and ONLY 5 DIGIT NUMBERS. minimum number 11,111 no zeros, LOTS of math to do.

So 9(number of digits in place 1) * (# of place 2) * 9....

9*9*9*9*9 = 59049

it gets worse when they CANT repeat.

 
aight, I was bored. here's what I was talkin about....

you gotta enable macros...

first column, putin digits accepted (sep. by spaces) for exmaple:

"0 1 2 3 4 5 6 7 8 9"

w/o quotes if you wanted stuff from 0-9

second column put in number of place values (aka 2 digits, 3 digits, etc.)

"5"

w/o quotes if you wanted all 5-digit numbers using the numbers 0-9

hit run

and just so you don't think it's a virus or anything here's the code....I didn't do much error checking cause I don't really care if you put somethin in wrong. you could even use it for any character (doesn't have to be "numbers").

if you use big *** numbers it's gonna take a while cause all 5 digit numbers with 10 different numbers are 10^5 permutations = 100 thousand. so if you mess around and put in some huge number & get an overflow...oh well

Code:
Public Sub doIt()
   Dim thesheet As Worksheet
   Dim thebook As Workbook

   On Error GoTo waserr

   Set thebook = ActiveWorkbook
   Set thesheet = thebook.ActiveSheet

   Dim strDigits As String, strNumDigits As String, iNumDigits As Long
   Dim theDigits

   strDigits = thesheet.Cells(2, 1)
   strNumDigits = thesheet.Cells(2, 2)
   Err.Clear

   iNumDigits = CLng(strNumDigits)
   If Err.Number <> 0 Then
       GoTo waserr
   End If

   If strDigits <> "" Then
       Dim d As Long, thePositions, thePositionDigitIndexes
       Dim curNum As String, curIndex As Long


       theDigits = Split(strDigits, " ")
       ReDim Preserve theDigits(UBound(theDigits))
       ReDim thePositions(iNumDigits - 1)
       ReDim thePositionDigitIndexes(iNumDigits - 1)

       For d = 0 To UBound(thePositions)
           thePositions(d) = theDigits(0)
           thePositionDigitIndexes(d) = 0
       Next

       curIndex = 1

       curNum = ""
       Dim numTimesToDo As Long
       numTimesToDo = UBound(theDigits) + 1
       For d = 1 To UBound(thePositions)
           numTimesToDo = numTimesToDo * (UBound(theDigits) + 1)
       Next

       Dim curStuff As Long, rowOffset As Long, columnOffset As Long
       rowOffset = 0
       columnOffset = 0
       For curStuff = 1 To numTimesToDo
           For d = UBound(thePositions) To 0 Step -1
               thePositions(d) = theDigits(thePositionDigitIndexes(d))
           Next


           curNum = Join(thePositions, "")
           If curIndex > 65530 Then
               columnOffset = columnOffset + 2
               curIndex = 1
           End If
           thesheet.Cells(curIndex + 2, columnOffset + 1) = curStuff
           thesheet.Cells(curIndex + 2, columnOffset + 2) = curNum

           If curStuff = numTimesToDo Then
               Exit For
           End If
'1 2 3 / 3
'0 0 0 => 1 1 1
'0 0 1 => 1 1 2
'0 0 2 => 1 1 3
'0 0 3 => asdf 0 1 0
           Dim lastIndex As Long
           'if last position index = last digit, set it to first digit, & set next position to next digit

           lastIndex = thePositionDigitIndexes(UBound(thePositionDigitIndexes))
           lastIndex = lastIndex + 1
           thePositionDigitIndexes(UBound(thePositionDigitIndexes)) = lastIndex
           For d = UBound(thePositionDigitIndexes) To 0 Step -1
               Dim thisIndex As Long
               thisIndex = thePositionDigitIndexes(d)
               If thisIndex > UBound(theDigits) Then
                   thisIndex = 0
                   thePositionDigitIndexes(d - 1) = thePositionDigitIndexes(d - 1) + 1
                   thePositionDigitIndexes(d) = thisIndex
               End If
           Next
           curIndex = curIndex + 1
       Next

   End If

   GoTo getout


waserr:
   MsgBox Err.Description, vbCritical, "error"

getout:
   MsgBox "i'm out this *****"
   Exit Sub

End Sub
permutations_stuff.zip

 

Attachments

  • permutations_stuff.zip
    0 bytes · Views: 15
Activity
No one is currently typing a reply...

About this thread

qtipextra

5,000+ posts
The Original
Thread starter
qtipextra
Joined
Location
Idaho Falls, Idaho
Start date
Participants
Who Replied
Replies
27
Views
344
Last reply date
Last reply from
sumone
IMG_1789(1).jpg

AJ (ACE)

    Jun 28, 2026
  • 0
  • 0
20260625_201728.jpg

Mike Mccabe

    Jun 28, 2026
  • 0
  • 0

New threads

Top