VBA: Combining 4 colums into combinations, but skip double values

[Styx]

I need help with a combination generator.
I found some good startpoints here, but the result is too long, I need an extra filter.
In my (borrowed) example there are 4 colums of which 2 pairs are identical. (most of the times)
The combination I am looking for must skip the combination where the value from column A is identical to the value in column C, and also where the value from column B is identical to the value in column D.
In other words: result must be completely unique.
this is what I have:

Sub 4-column-combi()

Dim xDRg1, xDRg2, xDRg3, xDRg4 As Range
Dim xRg  As Range
Dim xStr As String
Dim xFN1, xFN2, xFN3, xFN4 As Integer
Dim xSV1, xSV2, xSV3, xSV4 As String

Columns("F:F").Select
    Selection.ClearContents
    Range("F1").Select

Set xDRg1 = Range("A1:A15")  'First column data
Set xDRg2 = Range("B1:B8")  'Second column data
Set xDRg3 = Range("C1:C15")  'Third column data
Set xDRg4 = Range("D1:D8")  'Third column data
xStr = "-"   'Separator
Set xRg = Range("F1")  'Output cell
 For xFN1 = 1 To xDRg1.Count
     xSV1 = xDRg1.Item(xFN1).Text
    
    For xFN2 = 1 To xDRg2.Count
        xSV2 = xDRg2.Item(xFN2).Text
      
      For xFN3 = 1 To xDRg3.Count
        xSV3 = xDRg3.Item(xFN3).Text
        
        For xFN4 = 1 To xDRg4.Count
          xSV4 = xDRg4.Item(xFN4).Text
        
        xRg.Value = xSV1 & xStr & xSV2 & xStr & xSV3 & xStr & xSV4
        
        Set xRg = xRg.Offset(1, 0)
       Next
     Next
  Next
Next
End Sub

result =

LB1.xlsm
	A	B	C	D	E	F
1	101	201	101	201		101-201-101-201
2	102	202	102	202		101-201-101-202
3	103	203	103	203		101-201-101-203
4	104	204	104	204		101-201-101-204
5	105	205	105	205		101-201-101-205
6	106	206	106	206		101-201-101-206
7	107	207	107	207		101-201-101-207
8	108	208	108	208		101-201-101-208
9	109		109			101-201-102-201
10	110		110			101-201-102-202
11	111		111			101-201-102-203
12	112		112			101-201-102-204
13	113		113			101-201-102-205
14	114		114			101-201-102-206
15	115		115			101-201-102-207
16						101-201-102-208
17						101-201-103-201
18						101-201-103-202
Blad1

(the result in F is way longer than in my screenshot)
You can already see that 1st result = 101-201-101-102 but this is invalid because there are double values in the result.
The first correct value from this list is the 10th one: 101-201-102-202
And it would be superb if result is also in 4 columns. e.g.: column F, G, H, I filled with the seperate values.
Of course column A, B, C and D are dynamic, so tomorrow list A and C are maybe 4 rows long and column B and D 12 rows.
and sometimes all 4 columns are the same. so then the first result correct could be 101-102-103-104.
And if I have a working result, then I like to have some tweaking parameters implemented, but above question is the most important, lets start with that.

Thanks in advance!

 

[DanteAmor]

Try this

Sub Combining4colums()
  Dim a As Variant, b As Variant, c As Variant, d As Variant, f As Variant
  Dim i As Long, j As Long, k As Long, m As Long, n As Long
  Dim dic As Object
  Dim vx As Variant
  
  a = Range("A1", Range("A" & Rows.Count).End(3)).Value
  b = Range("B1", Range("B" & Rows.Count).End(3)).Value
  c = Range("C1", Range("C" & Rows.Count).End(3)).Value
  d = Range("D1", Range("D" & Rows.Count).End(3)).Value
  ReDim f(1 To UBound(a) * UBound(b) * UBound(c) * UBound(d), 1 To 4)
  Set dic = CreateObject("Scripting.Dictionary")
  vx = Range("E1").Value
  
  For i = 1 To UBound(a)
    dic(a(i, 1)) = Empty
    For j = 1 To UBound(b)
      If Not dic.exists(b(j, 1)) Then
        dic(b(j, 1)) = Empty
        For k = 1 To UBound(c)
          If Not dic.exists(c(k, 1)) Then
            dic(c(k, 1)) = Empty
            For m = 1 To UBound(d)
              If Not dic.exists(d(m, 1)) Then
                If Abs(Val(Right(a(i, 1), 2)) + Val(Right(b(j, 1), 2)) - _
                       Val(Right(c(k, 1), 2)) - Val(Right(d(m, 1), 2))) <= vx Then
                  n = n + 1
                  f(n, 1) = a(i, 1)
                  f(n, 2) = b(j, 1)
                  f(n, 3) = c(k, 1)
                  f(n, 4) = d(m, 1)
                End If
              End If
            Next m
            dic.Remove c(k, 1)
          End If
        Next k
        dic.Remove b(j, 1)
      End If
    Next j
    dic.Remove a(i, 1)
  Next
  If n > 0 Then Range("F1").Resize(n, 4) = f
End Sub

 

[Styx]

Hi All,
The "approved"macro I use now for one year and I am happy with it.
Now it is time to implement a new "factor" if possible. I like it to be a seperate macro. (after running the first one)
I use the above marked macro for planning a tournament for double matches.
The unique combinations are a guarantee that no match is the same, but......
It is still possible that you will be matched with the same players more times than I like.
So I like to have 2 parameters extra which I like to tweak in an input box:
Par1 = Max amount of matches with same player
Par2 = Max amount of matches against a player
And the matches are all double or mixed double matches: male/male vs male/male or female/female vs female/female or male/female vs male/female
So range A/B vs range C/D from above aproved macro.

result I like to see:
A filtered list of matches where Player A is not playing more than "Par1" matches with player B and:
where Player A is not playing more than "Par2" matches against player C and:
where Player A is not playing more than "Par2" matches against player D.
And of course this also counts for Player B, C and D.
So the result list will be much shorter.

I doubt this is possible but there are some really smart people here
Thanks for your help in advance!

 

[Styx]

Also perfect! Thanks bebo021999 !! Just changing the E factor to the fixed cell E1 was enough.
But the next step is to filter also combinations which also aready exist but in a different combination.
There are double combinations but in different columns.
The FG combination with the HI combination may only exist once.
So if there is another combination where the FG combination (in any order) with HI combination (in any order) is the "same" with the FG and HI combination then these must be skipped, so only the unique FG and HI combination may remain.
I highlighted 2 rows with same combination but in different order, there are more in this short list. (e.g. row 2 and 7 are also the "same".)
In this example I like to keep the 1st unique combination in row 1 and skip row 6.

Test-Macro_c0.02.xlsm
	A	B	C	D	E	F	G	H	I	J
1	101	201	101	201	0	101	202	102	201	<--
2	102	202	102	202		101	203	102	202
3	103	203	103	203		101	203	103	201
4		204		204		101	204	102	203
5						101	204	103	202
6						102	201	101	202	<--
7						102	202	101	203
8						102	202	103	201
9						102	203	101	204
10						102	203	103	202
11						102	204	103	203
12						103	201	101	203
13						103	201	102	202
14						103	202	101	204
15						103	202	102	203
16						103	203	102	204
Blad1

Hi Bebo,
Super happy with your solution!
I do work with your macro now for a while and I like to expand it. I hope you can help me.
It also needs to check on combinations A/B and also C/D, these combinations may not exceed a new parameter which will be in Cell E2 (e.g. 3), thus combination A/B may not exceed the amount of value in Cell E2, and this also goes for combination CD.
So it also check on pair-combinations of 2 cells
Is this possible?
In this way I can play around to get the optimum amount of combinations:

If this works another expansion will be a check on Combination A/C, A/D, B/C, B/D which may not exceed the value in Cell E3

The goal is to set matches between tennis or badminton-players where player A may not play together with player B more than the amount which is set in Cell E2 and where player A may not play against with player C or D more than the amount which is set in Cell E3.
Cell E1 is the allowed difference in level of players, e.g. 101 is the best player and 103 is the worst player. 20x players can be the same or other gender. (male/female in mixed matches)
This way I hope to get the max amount of matches possible which comply to the settings in Cells 1 to 3.
Thanks in advance!

 

[bebo021999]

Since it is such a long time from last working code, and the new issue is quite new and difference, could you:
- Start again with new XL2BB (or attach sample sheet via gg drive, dropbox...is the best)
- Manual input few representative rows of output:
before
after

 

[Styx]

Since it is such a long time from last working code, and the new issue is quite new and difference, could you:
- Start again with new XL2BB (or attach sample sheet via gg drive, dropbox...is the best)
- Manual input few representative rows of output:
before
after

Hi Bebo,
Thanks, I'll do that.