How can this code be modified to eliminate duplicates?

Collapse
X
 
  • Time
  • Show
Clear All
new posts
  • Kirch1995
    New Member
    • Jul 2010
    • 1

    How can this code be modified to eliminate duplicates?

    I am trying in excel to take a list of teams A through ? and group them into sets of three. I found a code that would do this, but now I need to eliminate any repeat use of combinations. For example if one set is ABC then I can not use the combinations with AB, AC or BC in them. If anyone can help I would appreciate it. It is for a youth basketball league and I am VB illiterate.
    The code that I found is

    [Sub FindSets()
    Dim iA() As Integer
    Dim sUniv As String
    Dim iWanted As Integer
    Dim j As Integer
    Dim k As Integer

    sUniv = Cells(1, 1).Value
    iWanted = Cells(2, 1).Value

    ReDim iA(iWanted)
    For j = 1 To iWanted
    iA(j) = j
    Next j

    iRow = PutRow(iA, sUniv, 1)

    Do Until DoneYet(iA, Len(sUniv))
    j = WorkHere(iA, Len(sUniv))
    iA(j) = iA(j) + 1
    For k = j + 1 To iWanted
    iA(k) = iA(k - 1) + 1
    Next k
    iRow = PutRow(iA, sUniv, iRow)
    Loop
    End Sub

    Function DoneYet(iB, n) As Boolean
    iMax = UBound(iB)
    Temp = True
    For j = iMax To 1 Step -1
    If iB(j) <> j + (n - iMax) Then
    Temp = False
    End If
    Next
    DoneYet = Temp
    End Function

    Function WorkHere(iB, n) As Integer
    iMax = UBound(iB)
    j = iMax
    Do Until iB(j) <> j + (n - iMax)
    j = j - 1
    Loop
    WorkHere = j
    End Function

    Function PutRow(iB, sUniv, i)
    iMax = UBound(iB)
    sTemp = ""
    For j = 1 To iMax
    sTemp = sTemp & Mid(sUniv, iB(j), 1)
    Next j
    Cells(i, 2).Value = sTemp
    PutRow = i + 1
    End Function]

    I found this at http://excel.tips.net/Pages/T006766_Listing _Combinations.h tml
Working...