# Need advice on an algorithm

##### Board Regular
Hi, I have a nascar pool where each player has 5 car numbers. I'm wondering if there is an algorithm that would be able to tell me which players have the same teams.

Example: Bob has 48,3,2 and Bill has 48,3,2 and Jim has 24,48,1

So Bob and Bill have the same team.

Any advice on this? I know there are public sorting routines, so has anyone ever ran into something like this?

### Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use \$ signs: \$V\$2:\$Z\$99 will always point to V2:Z99, even after copying
So how is your data arranged (what cells hold what)?
If the car numbers are all in the same cell, write code to sort them in hi-to-low or low-to high order
Then sort the 2 columns (player name, car numbers ) by the car number column and then group the player names where the car number cells are the same

Hi, I made some progress with code I found. I can find the duplicates and color them, but I need to be able to pick them off and group them together so it says something like bill and bob are on the same team etc.

The names are in column A, and there are car picks in columns c through g I think. THere are 5 car numbers for each name. Up above, I think I said 3, but it is 5

Here is the code that will find the duplicates and color them different colors.

Code:
``````Sub FindDuplicateEntries()

Dim rng As Range
Dim searchresult As Range
Dim endcell As String 'Used to declare the dynamic array
Dim BigString As String
Dim xcount As Integer
Dim name As String
'Gets the number of rows in the B column
If Sheets("test").Range("C2").Value = "" Then
endcell = "2"
Else
endcell = Range("C2").End(xlDown).Row
End If
'Clear any colors from last iteration of code
Sheets("test").Range("a2:g" & endcell).Interior.Pattern = xlNone
clr = 3
Set rng = Sheets("test").Range("C2:C" & endcell) 'Set the range
For Each rcell In rng 'loop through each cell in the range. rcell is just the cell you are looking at. 422 on the first run through.
x = WorksheetFunction.CountIf(Columns(3), rcell) - 1 'count how many times the value occurs in the range. We subract 1 so we search two times.
If x > 0 Then 'if there is only 1 instance then it is not a duplicate so move on
BigString = rcell & rcell.Offset(0, 1).Value & rcell.Offset(0, 2).Value & rcell.Offset(0, 3).Value & rcell.Offset(0, 4).Value 'this is what we define a duplicate
StartAdd = rcell.Address  'He put this in just for demonstation purposes so we could see where it started in B2.
Set searchresult = rcell 'initalize the searchResult range so when we search, we can use this to search after the first value.
For xcount = 1 To x ' search for the other instances of the value
Set searchresult = rng.Find(What:=rcell, After:=searchresult, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
'check if the other instance is a duplicate. Note AddOfSearch is actually an address so when we put it in a Range object,
'we can actually append it like we did above for BigString.
'This does a union of those 6 cells to highlight them
.ColorIndex = clr 'highlight the instance found and the original
End With
End If
Next xcount ' Now it will search again because we know from above
'that xcount is equal to two so it needs to go find the next one.
End If
clr = clr + 1
Next rcell
End Sub``````

Try this
Code:
``````Option Explicit

Sub GroupTeams()
'ActiveSheet has names in column A and car numbers in C:G

Dim lLastRow As Long
Dim lRowIndex As Long
Dim lColIndex As Long
Dim aryCars(1 To 5) As Variant
Dim lCarIndex As Long
Dim aryData() As Variant
Dim lDataIndex As Long
Dim sCarConCat As String
Dim sOutput As String
Dim sGroup As String
Dim sCurCarGroup As String
Dim sLastCarGroup As String

With ActiveSheet
lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For lRowIndex = 2 To lLastRow
sCarConCat = vbNullString
'Put a rows' car numbers in array
For lColIndex = 3 To 7
aryCars(lColIndex - 2) = .Cells(lRowIndex, lColIndex)
Next
'Sort 1D array low-to-high
BubbleSortArray aryCars
'Concatenate cars
For lCarIndex = 1 To 5
sCarConCat = sCarConCat & aryCars(lCarIndex) & ","
Next
sCarConCat = Left(sCarConCat, Len(sCarConCat) - 1)
'Name and concatenated car array into data array
lDataIndex = lDataIndex + 1
ReDim Preserve aryData(1 To 2, 1 To lDataIndex)
aryData(1, lDataIndex) = .Cells(lRowIndex, 1).Value
aryData(2, lDataIndex) = sCarConCat
Next
End With

'Sort Data Array by sCarConCat
Sort2DArray aryData, 2

'Group Names with same sCarConCat string
sCurCarGroup = aryData(2, 1)
For lDataIndex = LBound(aryData, 2) To UBound(aryData, 2)
If aryData(2, lDataIndex) = sCurCarGroup Then
sGroup = sGroup & aryData(1, lDataIndex) & ", "
Else
sOutput = sOutput & Left(sGroup, Len(sGroup) - 2) & " with cars " & sCurCarGroup & vbLf
sLastCarGroup = sCurCarGroup
sCurCarGroup = aryData(2, lDataIndex)
sGroup = aryData(1, lDataIndex) & ", "
End If
Next
If sLastCarGroup <> aryData(2, UBound(aryData, 2)) Then
sOutput = sOutput & Left(sGroup, Len(sGroup) - 2) & " with cars " & sCurCarGroup & vbLf
End If

'Display Output
MsgBox sOutput, , "Car Groups"
Debug.Print sOutput

End Sub

Function BubbleSortArray(ary As Variant)

Dim lX As Long, lY As Long
Dim varTemp As Variant

For lX = LBound(ary) To UBound(ary) - 1
For lY = lX + 1 To UBound(ary)
If ary(lX) > ary(lY) Then
varTemp = ary(lY)
ary(lY) = ary(lX)
ary(lX) = varTemp
End If
Next
Next
BubbleSortArray = ary

End Function

Function Sort2DArray(ary2D As Variant, lSortColumn As Long)

Dim lY As Long, lZ As Long
Dim vTemp1 As Variant, vTemp2 As Variant

'Sort ary2D into order
For lY = LBound(ary2D, 2) To UBound(ary2D, 2) - 1
For lZ = lY + 1 To UBound(ary2D, 2)
If ary2D(lSortColumn, lY) > ary2D(lSortColumn, lZ) Then
vTemp1 = ary2D(1, lZ)
vTemp2 = ary2D(2, lZ)
ary2D(1, lZ) = ary2D(1, lY)
ary2D(2, lZ) = ary2D(2, lY)
ary2D(1, lY) = vTemp1
ary2D(2, lY) = vTemp2
End If
Next
Next

Sort2DArray = ary2D

End Function``````

Hi, I will look this over. It looks like it is giving me a list of car #'s from 1 to 43?

I am trying to find out which players have picked the same cars, so

it would put on the spreadsheet

Same Teams:
Bob and Bill

Maybe this is what you have given me, but I need to look into it here in the next hour.

Thanks for the help!

Oh, I think it worked the 2nd time I hit run! Wow, that is amazing.

Very Much Appreciated! I have a free hour here soon, and will look further into it.

Last edited:
Hi Phil, can you tell me what this code does?
'Sort Data Array by sCarConCat
Sort2DArray aryData, 2

I know the data Array has all the players names in row 1 and underneath that in row 2, are each players string of 5 cars. What will the array look like after it is sorted?

And Also, how would I modify the grouping code to just print out the groups? Currently, the print out prints single players and their cars. Is it possible to print just when players have the same teams?

Code:
``````Option Explicit

Sub GroupTeams()
'ActiveSheet has names in column A and car numbers in C:G

Dim lLastRow As Long
Dim lRowIndex As Long
Dim lColIndex As Long
Dim aryCars(1 To 5) As Variant
Dim lCarIndex As Long
Dim aryData() As Variant
Dim lDataIndex As Long
Dim sCarConCat As String
Dim sOutput As String
Dim sGroup As String
Dim sCurCarGroup As String
Dim sLastCarGroup As String

With ActiveSheet
lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'Get the last row of data in Column A

For lRowIndex = 2 To lLastRow   'Check each row from row 2 to the last row
sCarConCat = vbNullString   'Clear the varoable that will hold the 5 cars in each row (columns C:G)
'Put a rows' car numbers in array
For lColIndex = 3 To 7
aryCars(lColIndex - 2) = .Cells(lRowIndex, lColIndex)
Next
'Sort 1D array of each row's 5 car numbers low-to-high
BubbleSortArray aryCars

'Concatenate cars so the 5 numbers (now low-to-high), separated by _
commas are put together in a single string named sCarConCat
For lCarIndex = 1 To 5
sCarConCat = sCarConCat & aryCars(lCarIndex) & ","
Next
sCarConCat = Left(sCarConCat, Len(sCarConCat) - 1)

'Name and concatenated car array (sCarConCat) into data array
lDataIndex = lDataIndex + 1
ReDim Preserve aryData(1 To 2, 1 To lDataIndex)
aryData(1, lDataIndex) = .Cells(lRowIndex, 1).Value 'First column in the array holds the name
aryData(2, lDataIndex) = sCarConCat  'Second column in the array holds sCarConCat for that name
Next
End With

'Sort bith columns of the Data Array by the seccond column in the array (sCarConCat) this will group
'  the people with the same cars together
Sort2DArray aryData, 2

'Group Names with same sCarConCat string
sCurCarGroup = aryData(2, 1)    'Get the car group for the first name

For lDataIndex = LBound(aryData, 2) To UBound(aryData, 2)
If aryData(2, lDataIndex) = sCurCarGroup Then
'Check the car group of each name.  As long as the car group is the same, add the
'  player name to the variable sGroup
sGroup = sGroup & aryData(1, lDataIndex) & ", "
Else
'If the car group is different copy the people names and the car group to the sOutput variable
sOutput = sOutput & Left(sGroup, Len(sGroup) - 2) & " with cars " & sCurCarGroup & vbLf

sLastCarGroup = sCurCarGroup    'Save the name of the car group just written to sOutput
sCurCarGroup = aryData(2, lDataIndex)   'save the name of the next car group to sCurCarGroup
sGroup = aryData(1, lDataIndex) & ", "  'save the first player with that car group to the sGroup variable
End If
Next

'If the car group for the last player does not equal the car group just written to sOutput
'  save the last player and the last cargroup to sOutput.  This will only occur if only 1
'  person has the last car group
If sLastCarGroup <> aryData(2, UBound(aryData, 2)) Then
sOutput = sOutput & Left(sGroup, Len(sGroup) - 2) & " with cars " & sCurCarGroup & vbLf
End If

'Display Output
MsgBox sOutput, , "Car Groups"
Debug.Print sOutput

End Sub

Function BubbleSortArray(ary As Variant)

Dim lX As Long, lY As Long
Dim varTemp As Variant

For lX = LBound(ary) To UBound(ary) - 1
For lY = lX + 1 To UBound(ary)
If ary(lX) > ary(lY) Then
varTemp = ary(lY)
ary(lY) = ary(lX)
ary(lX) = varTemp
End If
Next
Next
BubbleSortArray = ary

End Function

Function Sort2DArray(ary2D As Variant, lSortColumn As Long)

Dim lY As Long, lZ As Long
Dim vTemp1 As Variant, vTemp2 As Variant

'Sort ary2D into order
For lY = LBound(ary2D, 2) To UBound(ary2D, 2) - 1
For lZ = lY + 1 To UBound(ary2D, 2)
If ary2D(lSortColumn, lY) > ary2D(lSortColumn, lZ) Then
vTemp1 = ary2D(1, lZ)
vTemp2 = ary2D(2, lZ)
ary2D(1, lZ) = ary2D(1, lY)
ary2D(2, lZ) = ary2D(2, lY)
ary2D(1, lY) = vTemp1
ary2D(2, lY) = vTemp2
End If
Next
Next

Sort2DArray = ary2D

End Function``````

If different people pick the exact same 5 cars, then they should be shown on the same line. Is that not happening for you?

Using the data from your example:

Excel Workbook
ABCDEFG
1Name*Car 1Car 2Car 3Car 4Car 5
2Bob*4832**
3Bill*2348**
4Jim*24481**
Sheet1

I get this result:

Jim with cars ,,1,24,48
Bill, Bob with cars ,,2,3,48

Is the first car number in column C ?

Hi Phil, thanks for staying with this. The code is working the way you have it, but I'm wondering if you can just print out the players that have the same team. So in your example, Jim would be left out.

Only thing that would be printed would be
Bill, Bob with cars ,,2,3,48

I'm trying to figure out how to add my data, but I don't think you need it. You have exactly what I have.

Last edited:

Replies
6
Views
349
Replies
4
Views
277
Replies
0
Views
161
Replies
2
Views
295
Replies
5
Views
1K

1,203,756
Messages
6,057,162
Members
444,909
Latest member
Shambles111

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back