Multiple comparison of list items.

  • Thread starter Thread starter Paulie
  • Start date Start date
P

Paulie

Hi, I need to give the users of my data a spreadsheet with the option
of 'choosing' which items are relevant to their needs. I need them to
make a preference choice between all the possible combinations, using
VLOOKUP.

Where my problem is though is as follows. I have a list of unique part
numbers in a column. I need a macro to prepare a list that I can do
some further comparitive work on. My list looks something like this.

Column A
00237
00243
00251
00377

I need to be able to cross reference each part number with each of the
others, generating a list which wil look like the following:

Column A Column B
00237 00243
00237 00251
00237 00377
00243 00251
00243 00377
00251 00377

In essence, I need to create a rows that have every possible
combination of part numbers.

If I can get to the above result, I can handle the VLOOKUP part of the
equation.

Any help greatly appreciated
 
Why wouldn't 00243 have a cross reference to 00377

All combinations would mean each part number would have 3 cross references,
but your sample seems to be that there is no cross reference to previous
part numbers. You need to be more specific in what you want.
 
Hi
Assuming your part numbers are on a sheet called "PartNumbers" and
that your combinations will go on "Part Combinations". You should have
Option Base 1 at the top of your code module.
Select the original part numbers and run this macro:

Sub Combine()
Dim PartNumbers As Variant
Dim Combinations As New Collection
Dim PartCount As Long
Dim i As Long, j As Long
Application.ScreenUpdating = False
Worksheets("PartNumbers").Activate
PartNumbers = Selection.Value
PartCount = UBound(PartNumbers, 1)
If PartCount = 1 Then
MsgBox "You need more than one part!", vbOKOnly, "Help
Combining Parts"
Exit Sub
End If
On Error Resume Next
For i = 1 To PartCount - 1
For j = i To PartCount
Combinations.Add Array(PartNumbers(i, 1), PartNumbers(j,
1)), _
PartNumbers(i, 1) & PartNumbers(j,
1)
Next j
Next i
On Error GoTo 0

With Worksheets("Part Combinations")
For i = 1 To Combinations.Count
.Cells(i, 1).Resize(1, 2).Value = Combinations(i)
Next i
.Activate
End With
Set Combinations = Nothing
End Sub

This will give unique combinations even if some of your Part Numbers
are repeated.

regards
Paul
 
Back
Top