Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

Generate all 4 digit-numbers using only 9,8,6,5,3

0

Need to generate all posible 4 digit numbers using only 9,8,6,5,3

Answer
Discuss

Discussion

See if this works for you. It will take those numbers and generate a list of all possible permutations. There are 5! = 120 permutations. It enters each result as a single result in a cell.   https://www.extendoffice.com/documents/excel/3657-excel-generate-all-permutations.html
gebobs (rep: 30) May 18, '17 at 9:33 am
does not looks right, just by the amount possible combinations. May be I am not clear on what I need, I have a plate from the vehicle,XXX-9835, and I have a person who saw the plate, while letters clearly visible on the video, person not sure about "roundish numbers" viz. 9 8 6 5 3, thus in order to run a plate through the database to match vehicle description I need list of all possible combinations of 4 digtit numbers made up of those 5 digits.
olegtf May 18, '17 at 10:05 am
Add to Discussion

Answers

0

I did a quick search and found this (made a minor edit or two):

Dim vAllItems As Variant
Dim Buffer() As String
Dim BufferPtr As Long
Dim Results As Worksheet
'
'  Posted by Myrna Larson
'  Edited for TeachExcel.com
Sub ListPermutations()
  Dim Rng As Range
  Dim PopSize As Integer
  Dim SetSize As Integer
  Dim Which As String
  Dim N As Double
  Const BufferSize As Long = 4096
  Set Rng = Selection.Columns(1).Cells
  If Rng.Cells.Count = 1 Then
    Set Rng = Range(Rng, Rng.End(xlDown))
  End If
  PopSize = Rng.Cells.CountLarge - 2
  If PopSize < 2 Then GoTo DataError
  SetSize = Rng.Cells(2).Value
  If SetSize > PopSize Then GoTo DataError
  Which = UCase$(Rng.Cells(1).Value)
  Select Case Which
  Case "C"
    N = Application.WorksheetFunction.Combin(PopSize, SetSize)
  Case "P"
    N = Application.WorksheetFunction.Permut(PopSize, SetSize)
  Case Else
    GoTo DataError
  End Select
  If N > Cells.CountLarge Then GoTo DataError
  Application.ScreenUpdating = False
  Set Results = Worksheets.Add
  vAllItems = Rng.Offset(2, 0).Resize(PopSize).Value
  ReDim Buffer(1 To BufferSize) As String
  BufferPtr = 0
  If Which = "C" Then
    AddCombination PopSize, SetSize
  Else
    AddPermutation PopSize, SetSize
  End If
  vAllItems = 0
  Application.ScreenUpdating = True
  Exit Sub
DataError:
  If N = 0 Then
    Which = "Enter your data in a vertical range of at least 4 cells. " _
      & String$(2, 10) _
      & "Top cell must contain the letter C or P, 2nd cell is the number " _
      & "of items in a subset, the cells below are the values from which " _
      & "the subset is to be chosen."
  Else
    Which = "This requires " & Format$(N, "#,##0") & _
      " cells, more than are available on the worksheet!"
  End If
  MsgBox Which, vbOKOnly, "DATA ERROR"
  Exit Sub
End Sub
Private Sub AddPermutation(Optional PopSize As Integer = 0, _
  Optional SetSize As Integer = 0, _
  Optional NextMember As Integer = 0)
  Static iPopSize As Integer
  Static iSetSize As Integer
  Static SetMembers() As Integer
  Static Used() As Integer
  Dim i As Integer
  If PopSize <> 0 Then
    iPopSize = PopSize
    iSetSize = SetSize
    ReDim SetMembers(1 To iSetSize) As Integer
    ReDim Used(1 To iPopSize) As Integer
    NextMember = 1
  End If
  For i = 1 To iPopSize
    If Used(i) = 0 Then
      SetMembers(NextMember) = i
      If NextMember <> iSetSize Then
        Used(i) = True
        AddPermutation , , NextMember + 1
        Used(i) = False
      Else
        SavePermutation SetMembers()
      End If
    End If
  Next i
  If NextMember = 1 Then
    SavePermutation SetMembers(), True
    Erase SetMembers
    Erase Used
  End If
End Sub  'AddPermutation
Private Sub AddCombination(Optional PopSize As Integer = 0, _
  Optional SetSize As Integer = 0, _
  Optional NextMember As Integer = 0, _
  Optional NextItem As Integer = 0)
  Static iPopSize As Integer
  Static iSetSize As Integer
  Static SetMembers() As Integer
  Dim i As Integer
  If PopSize <> 0 Then
    iPopSize = PopSize
    iSetSize = SetSize
    ReDim SetMembers(1 To iSetSize) As Integer
    NextMember = 1
    NextItem = 1
  End If
  For i = NextItem To iPopSize
    SetMembers(NextMember) = i
    If NextMember <> iSetSize Then
      AddCombination , , NextMember + 1, i + 1
    Else
      SavePermutation SetMembers()
    End If
  Next i
  If NextMember = 1 Then
    SavePermutation SetMembers(), True
    Erase SetMembers
  End If
End Sub  'AddCombination
Private Sub SavePermutation(ItemsChosen() As Integer, _
  Optional FlushBuffer As Boolean = False)
  Dim i As Integer, sValue As String
  Static RowNum As Long, ColNum As Long
  If RowNum = 0 Then RowNum = 1
  If ColNum = 0 Then ColNum = 1
  If FlushBuffer = True Or BufferPtr = UBound(Buffer()) Then
    If BufferPtr > 0 Then
      If (RowNum + BufferPtr - 1) > Rows.Count Then
        RowNum = 1
        ColNum = ColNum + 1
        If ColNum > 256 Then Exit Sub
      End If
      Results.Cells(RowNum, ColNum).Resize(BufferPtr, 1).Value _
        = Application.WorksheetFunction.Transpose(Buffer())
      RowNum = RowNum + BufferPtr
    End If
    BufferPtr = 0
    If FlushBuffer = True Then
      Erase Buffer
      RowNum = 0
      ColNum = 0
      Exit Sub
    Else
      ReDim Buffer(1 To UBound(Buffer))
    End If
  End If
  'construct the next set
  For i = 1 To UBound(ItemsChosen)
    sValue = sValue & "" & vAllItems(ItemsChosen(i), 1)
  Next i
  'and save it in the buffer
  BufferPtr = BufferPtr + 1
  Buffer(BufferPtr) = Mid$(sValue, 1)
End Sub  'SavePermutation

On Sheet1 enter data like this:

A1 P to get permutations or C to get combinations. I used P.

A2 The size of fhe number/result. Use 4 for your case.

A3... The items/numbers that you want to combine. Put one number per cell going down. For you, 9 in A3, 8 in A4, etc.

Select cell A1 and run the macro.

(This is a hefty macro but it should do what you need.)

Discuss

Discussion

Thank you very much for your responce. I am getting "Runtime error 6 overflow" debug option highlighted   PopSize = Rng.Cells.CountLarge - 2
well... I went "easier way" - created list from 0000 to 9999 and as of now deleting any cell containg 0, 1, 2, 4, 7... probably will be done by the end of the day :-) still, thank you very much...
olegtf May 18, '17 at 3:17 pm
You are in Excel 2010 or 2013 right? Because I initially had issues but worked them out for my 2016 version. I can't reproduce that issue in Excel 2016; the CountLarge part replaced the error causing Count part in the original macro.
don (rep: 1989) May 19, '17 at 2:37 am
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login