Recent

6/recent/ticker-posts

Header Ads Widget

VB Code for Create Possible Combination From given Numbers in Excel

This is the vb Example for the permutation without repetition in excel 


Function ListPermut(str As String, num As Integer)
'Permutations without repetition
Dim c, r, p As Long
Dim rng() As Long, temp As Long, i As Long
Dim temp1 As Long, y() As Long, d As Long
Dim tmpOut(), tmpArr() As Variant
Dim j As Integer
Dim a As Boolean
ReDim tmpArr(0)
ReDim tmpOut(0)
For j = 1 To Len(str)
    tmpArr(UBound(tmpArr)) = Mid(str, j, 1)
    ReDim Preserve tmpArr(UBound(tmpArr) + 1)
Next j
ReDim Preserve tmpArr(UBound(tmpArr) - 1)
p = WorksheetFunction.Permut(Len(str), Len(str))
ReDim rng(1 To p, 1 To Len(str))
For c = 1 To Len(str)
  rng(1, c) = c
Next c
For r = 2 To p
    For c = 1 To num
      tmpOut(UBound(tmpOut)) = tmpOut(UBound(tmpOut)) & tmpArr(rng(r - 1, c) - 1)
    Next c
   
    If UBound(tmpOut) <> 0 Then
        If tmpOut(UBound(tmpOut)) = tmpOut(UBound(tmpOut) - 1) Then
            tmpOut(UBound(tmpOut)) = ""
        Else
            ReDim Preserve tmpOut(UBound(tmpOut) + 1)
        End If
    Else
        ReDim Preserve tmpOut(UBound(tmpOut) + 1)
    End If
For c = Len(str) To 1 Step -1
  If rng(r - 1, c - 1) < rng(r - 1, c) Then
    temp = c - 1
    Exit For
  End If
Next c
 
  For c = Len(str) To 1 Step -1
    rng(r, c) = rng(r - 1, c)
  Next c

  For c = Len(str) To 1 Step -1
      If rng(r - 1, c) > rng(r - 1, temp) Then
          temp1 = rng(r - 1, temp)
          rng(r, temp) = rng(r - 1, c)
          rng(r, c) = temp1
          ReDim y(Len(str) - temp)
          i = 0
          For d = temp + 1 To Len(str)
            y(i) = rng(r, d)
            i = i + 1
          Next d
          i = 0
          For d = Len(str) To temp + 1 Step -1
            rng(r, d) = y(i)
            i = i + 1
          Next d
          Exit For
      End If
  Next c
 
If r = p Then
    For c = 1 To num
      tmpOut(UBound(tmpOut)) = tmpOut(UBound(tmpOut)) & tmpArr(rng(r, c) - 1)
    Next c
    If tmpOut(UBound(tmpOut)) = tmpOut(UBound(tmpOut) - 1) Then
        ReDim Preserve tmpOut(UBound(tmpOut) - 1)
    End If
End If
Next r
 
ListPermut = Application.Transpose(tmpOut)
End Function

Post a Comment

6 Comments

  1. This comment has been removed by the author.

    ReplyDelete
  2. Hello...I need your help to create a formula in excel for generating all possible combinations (not permutations) to form a new group without repetitions.

    1. Details: There are two groups A & B. A contains 10 Men and B contains 10 Women.
    2. Requirement: I need to create a new group C by taking people from groups A & B.
    3. Conditions:
    i. Total people for new group should be 10.
    ii. Minimum 3 and maximum of 7 can be taken from each group.

    ReplyDelete
  3. Above is just an example for one of my requirements

    ReplyDelete

thank you for your comment