Hi

I have been looking into this for few weeks now but I can't find a
solution ...

I have 200 rows of data composed of numbers from 1 to 10 on column A
to F.

I need to find out the most pair / triplet for the all table. Perhaps
the following example will explain better


1_2_3_4_5_6
1_2_5_6_7_9
2_3_5_6_7_8
3_4_6_7_8_9
1_3_5_6_7_8

Most common pair = 6_7
Most common triplet = 5_6_7

Hope this is clear ... thank you in advance

A

maybe something like this:

Sub MostCommonPair()
Dim rng As Range
Dim c As Range
Dim strPair As String
Dim ws As Worksheet
Dim lRow As Long
Dim lRow2 As Long
Dim lCount As Long

Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F"))

Application.ScreenUpdating = False
Application.DisplayAlerts = False

If Not rng Is Nothing Then
Set ws = ActiveWorkbook.Worksheets.Add
lRow = 1
For Each c In rng
If c.Column <= 5 Then
strPair = c.Value & "_" & c.Offset(0, 1).Value

On Error Resume Next
lRow2 = Application.WorksheetFunction.Match(strPair,
ws.Range("A:A"), False)
If Err.Number 0 Then
ws.Range("A" & lRow).Value = strPair
ws.Range("B" & lRow).Value = 1
lRow = lRow + 1
Else
ws.Range("B" & lRow2).Value = ws.Range("B" &
lRow2).Value + 1
End If
On Error GoTo 0
End If
Next c
End If

'get the one with largest count
With Application.WorksheetFunction
lCount = .Large(ws.Range("B:B"), 1)
lRow = .Match(lCount, ws.Range("B:B"), False)
End With
MsgBox "Most Common Pair is " & ws.Range("A" & lRow) & " (" & lCount & "
occurrences)"

ws.Delete

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub


Sub MostCommonTriplet()
Dim rng As Range
Dim c As Range
Dim strTriplet As String
Dim ws As Worksheet
Dim lRow As Long
Dim lRow2 As Long
Dim lCount As Long

Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F"))

Application.ScreenUpdating = False
Application.DisplayAlerts = False

If Not rng Is Nothing Then
Set ws = ActiveWorkbook.Worksheets.Add
lRow = 1
For Each c In rng
If c.Column <= 4 Then
strTriplet = c.Value & "_" & c.Offset(0, 1).Value & "_" &
c.Offset(0, 2).Value

On Error Resume Next
lRow2 = Application.WorksheetFunction.Match(strTriplet,
ws.Range("A:A"), False)
If Err.Number 0 Then
ws.Range("A" & lRow).Value = strTriplet
ws.Range("B" & lRow).Value = 1
lRow = lRow + 1
Else
ws.Range("B" & lRow2).Value = ws.Range("B" &
lRow2).Value + 1
End If
On Error GoTo 0
End If
Next c
End If

'get the one with largest count
With Application.WorksheetFunction
lCount = .Large(ws.Range("B:B"), 1)
lRow = .Match(lCount, ws.Range("B:B"), False)
End With
MsgBox "Most Common Triplet is " & ws.Range("A" & lRow) & " (" & lCount
& " occurrences)"

ws.Delete

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub



--
Hope that helps.

Vergel Adriano


" wrote:

Hi

I have been looking into this for few weeks now but I can't find a
solution ...

I have 200 rows of data composed of numbers from 1 to 10 on column A
to F.

I need to find out the most pair / triplet for the all table. Perhaps
the following example will explain better


1_2_3_4_5_6
1_2_5_6_7_9
2_3_5_6_7_8
3_4_6_7_8_9
1_3_5_6_7_8

Most common pair = 6_7
Most common triplet = 5_6_7

Hope this is clear ... thank you in advance

A

On Aug 12, 12:28 am, Vergel Adriano
wrote:
maybe something like this:

Sub MostCommonPair()
Dim rng As Range
Dim c As Range
Dim strPair As String
Dim ws As Worksheet
Dim lRow As Long
Dim lRow2 As Long
Dim lCount As Long

Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F"))

Application.ScreenUpdating = False
Application.DisplayAlerts = False

If Not rng Is Nothing Then
Set ws = ActiveWorkbook.Worksheets.Add
lRow = 1
For Each c In rng
If c.Column <= 5 Then
strPair = c.Value & "_" & c.Offset(0, 1).Value

On Error Resume Next
lRow2 = Application.WorksheetFunction.Match(strPair,
ws.Range("A:A"), False)
If Err.Number 0 Then
ws.Range("A" & lRow).Value = strPair
ws.Range("B" & lRow).Value = 1
lRow = lRow + 1
Else
ws.Range("B" & lRow2).Value = ws.Range("B" &
lRow2).Value + 1
End If
On Error GoTo 0
End If
Next c
End If

'get the one with largest count
With Application.WorksheetFunction
lCount = .Large(ws.Range("B:B"), 1)
lRow = .Match(lCount, ws.Range("B:B"), False)
End With
MsgBox "Most Common Pair is " & ws.Range("A" & lRow) & " (" & lCount & "
occurrences)"

ws.Delete

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Sub MostCommonTriplet()
Dim rng As Range
Dim c As Range
Dim strTriplet As String
Dim ws As Worksheet
Dim lRow As Long
Dim lRow2 As Long
Dim lCount As Long

Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F"))

Application.ScreenUpdating = False
Application.DisplayAlerts = False

If Not rng Is Nothing Then
Set ws = ActiveWorkbook.Worksheets.Add
lRow = 1
For Each c In rng
If c.Column <= 4 Then
strTriplet = c.Value & "_" & c.Offset(0, 1).Value & "_" &
c.Offset(0, 2).Value

On Error Resume Next
lRow2 = Application.WorksheetFunction.Match(strTriplet,
ws.Range("A:A"), False)
If Err.Number 0 Then
ws.Range("A" & lRow).Value = strTriplet
ws.Range("B" & lRow).Value = 1
lRow = lRow + 1
Else
ws.Range("B" & lRow2).Value = ws.Range("B" &
lRow2).Value + 1
End If
On Error GoTo 0
End If
Next c
End If

'get the one with largest count
With Application.WorksheetFunction
lCount = .Large(ws.Range("B:B"), 1)
lRow = .Match(lCount, ws.Range("B:B"), False)
End With
MsgBox "Most Common Triplet is " & ws.Range("A" & lRow) & " (" & lCount
& " occurrences)"

ws.Delete

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

--
Hope that helps.

Vergel Adriano

" wrote:
Hi

I have been looking into this for few weeks now but I can't find a
solution ...

I have 200 rows of data composed of numbers from 1 to 10 on column A
to F.

I need to find out the most pair / triplet for the all table. Perhaps
the following example will explain better

1_2_3_4_5_6
1_2_5_6_7_9
2_3_5_6_7_8
3_4_6_7_8_9
1_3_5_6_7_8

Most common pair = 6_7
Most common triplet = 5_6_7

Hope this is clear ... thank you in advance

A

THANK YOU Adriano

works perfectly ... I want to spend some time reviewing the code to
understand the all process.

Thanks again
A

Hi Vergel Adriano,

Sorry to jump in here A.
Would it be possible to adapt the codes so it outputs ALL the
combinations of Pairs & Triplets with the total amount of times they
have appeared please.
Maybe the results could go in a sheet named "Results" and :-
(1) The Pairs go in Cells "A1" & "B1" going down and the total times
appeared in Cell "C1" going down.
(2) The Triples go in Cells "E1", "F1" & "G1" going down and the total
times appeared in Cell "H1" going down.

Thanks in Advance.
All the Best.
Paul

On Aug 12, 12:28 am, Vergel Adriano
wrote:
maybe something like this:

Sub MostCommonPair()
Dim rng As Range
Dim c As Range
Dim strPair As String
Dim ws As Worksheet
Dim lRow As Long
Dim lRow2 As Long
Dim lCount As Long

Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F"))

Application.ScreenUpdating = False
Application.DisplayAlerts = False

If Not rng Is Nothing Then
Set ws = ActiveWorkbook.Worksheets.Add
lRow = 1
For Each c In rng
If c.Column <= 5 Then
strPair = c.Value & "_" & c.Offset(0, 1).Value

On Error Resume Next
lRow2 = Application.WorksheetFunction.Match(strPair,
ws.Range("A:A"), False)
If Err.Number 0 Then
ws.Range("A" & lRow).Value = strPair
ws.Range("B" & lRow).Value = 1
lRow = lRow + 1
Else
ws.Range("B" & lRow2).Value = ws.Range("B" &
lRow2).Value + 1
End If
On Error GoTo 0
End If
Next c
End If

'get the one with largest count
With Application.WorksheetFunction
lCount = .Large(ws.Range("B:B"), 1)
lRow = .Match(lCount, ws.Range("B:B"), False)
End With
MsgBox "Most Common Pair is " & ws.Range("A" & lRow) & " (" & lCount & "
occurrences)"

ws.Delete

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Sub MostCommonTriplet()
Dim rng As Range
Dim c As Range
Dim strTriplet As String
Dim ws As Worksheet
Dim lRow As Long
Dim lRow2 As Long
Dim lCount As Long

Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F"))

Application.ScreenUpdating = False
Application.DisplayAlerts = False

If Not rng Is Nothing Then
Set ws = ActiveWorkbook.Worksheets.Add
lRow = 1
For Each c In rng
If c.Column <= 4 Then
strTriplet = c.Value & "_" & c.Offset(0, 1).Value & "_" &
c.Offset(0, 2).Value

On Error Resume Next
lRow2 = Application.WorksheetFunction.Match(strTriplet,
ws.Range("A:A"), False)
If Err.Number 0 Then
ws.Range("A" & lRow).Value = strTriplet
ws.Range("B" & lRow).Value = 1
lRow = lRow + 1
Else
ws.Range("B" & lRow2).Value = ws.Range("B" &
lRow2).Value + 1
End If
On Error GoTo 0
End If
Next c
End If

'get the one with largest count
With Application.WorksheetFunction
lCount = .Large(ws.Range("B:B"), 1)
lRow = .Match(lCount, ws.Range("B:B"), False)
End With
MsgBox "Most Common Triplet is " & ws.Range("A" & lRow) & " (" & lCount
& " occurrences)"

ws.Delete

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

--
Hope that helps.

Vergel Adriano



" wrote:
Hi

I have been looking into this for few weeks now but I can't find a
solution ...

I have 200 rows of data composed of numbers from 1 to 10 on column A
to F.

I need to find out the most pair / triplet for the all table. Perhaps
the following example will explain better

1_2_3_4_5_6
1_2_5_6_7_9
2_3_5_6_7_8
3_4_6_7_8_9
1_3_5_6_7_8

Most common pair = 6_7
Most common triplet = 5_6_7

Hope this is clear ... thank you in advance

A- Hide quoted text -

- Show quoted text -

Hi Paul,

Give this a try.

Sub MostCommonPairAndTriplet()
Dim rng As Range
Dim c As Range
Dim strPair As String
Dim strTriplet As String
Dim wsResult As Worksheet
Dim lRow As Long
Dim lRow2 As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F"))

If Not rng Is Nothing Then

'Get the result worksheet
On Error Resume Next
Set wsResult = ActiveWorkbook.Worksheets("Results")
If wsResult Is Nothing Then
Set wsResult = ActiveWorkbook.Worksheets.Add
wsResult.Name = "Results"
Else
wsResult.UsedRange.Delete
End If
'column labels
With wsResult
.Range("B1").Value = "Value1"
.Range("C1").Value = "Value2"
.Range("D1").Value = "Count"
.Range("F1").Value = "Value1"
.Range("G1").Value = "Value2"
.Range("H1").Value = "Value3"
.Range("I1").Value = "Count"
End With
On Error GoTo 0

'Find Pairs
lRow = 2
For Each c In rng
If c.Column <= 5 Then
strPair = c.Value & "_" & c.Offset(0, 1).Value

On Error Resume Next
lRow2 = Application.WorksheetFunction.Match(strPair,
wsResult.Range("A:A"), False)
If Err.Number 0 Then
wsResult.Range("A" & lRow).Value = strPair
wsResult.Range("B" & lRow).Value = c.Value
wsResult.Range("C" & lRow).Value = c.Offset(0, 1).Value
wsResult.Range("D" & lRow).Value = 1
lRow = lRow + 1
Else
wsResult.Range("D" & lRow2).Value = wsResult.Range("D" &
lRow2).Value + 1
End If
On Error GoTo 0
End If
Next c

'Find Triplets
lRow = 2
For Each c In rng
If c.Column <= 4 Then
strTriplet = c.Value & "_" & c.Offset(0, 1).Value & "_" &
c.Offset(0, 2).Value

On Error Resume Next
lRow2 = Application.WorksheetFunction.Match(strTriplet,
wsResult.Range("E:E"), False)
If Err.Number 0 Then
wsResult.Range("E" & lRow).Value = strTriplet
wsResult.Range("F" & lRow).Value = c.Value
wsResult.Range("G" & lRow).Value = c.Offset(0, 1).Value
wsResult.Range("H" & lRow).Value = c.Offset(0, 2).Value
wsResult.Range("I" & lRow).Value = 1
lRow = lRow + 1
Else
wsResult.Range("I" & lRow2).Value = wsResult.Range("I" &
lRow2).Value + 1
End If
On Error GoTo 0
End If
Next c
End If

wsResult.Columns("E").Clear
wsResult.Columns("A").Delete

'Sort the pairs
With wsResult
.Columns("A:C").Sort Key1:=.Range("C2"), Order1:=xlDescending
.Columns("E:H").Sort Key1:=.Range("H2"), Order1:=xlDescending
End With


Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub


--
Hope that helps.

Vergel Adriano


"Paul Black" wrote:

Hi Vergel Adriano,

Sorry to jump in here A.
Would it be possible to adapt the codes so it outputs ALL the
combinations of Pairs & Triplets with the total amount of times they
have appeared please.
Maybe the results could go in a sheet named "Results" and :-
(1) The Pairs go in Cells "A1" & "B1" going down and the total times
appeared in Cell "C1" going down.
(2) The Triples go in Cells "E1", "F1" & "G1" going down and the total
times appeared in Cell "H1" going down.

Thanks in Advance.
All the Best.
Paul

On Aug 12, 12:28 am, Vergel Adriano
wrote:
maybe something like this:

Sub MostCommonPair()
Dim rng As Range
Dim c As Range
Dim strPair As String
Dim ws As Worksheet
Dim lRow As Long
Dim lRow2 As Long
Dim lCount As Long

Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F"))

Application.ScreenUpdating = False
Application.DisplayAlerts = False

If Not rng Is Nothing Then
Set ws = ActiveWorkbook.Worksheets.Add
lRow = 1
For Each c In rng
If c.Column <= 5 Then
strPair = c.Value & "_" & c.Offset(0, 1).Value

On Error Resume Next
lRow2 = Application.WorksheetFunction.Match(strPair,
ws.Range("A:A"), False)
If Err.Number 0 Then
ws.Range("A" & lRow).Value = strPair
ws.Range("B" & lRow).Value = 1
lRow = lRow + 1
Else
ws.Range("B" & lRow2).Value = ws.Range("B" &
lRow2).Value + 1
End If
On Error GoTo 0
End If
Next c
End If

'get the one with largest count
With Application.WorksheetFunction
lCount = .Large(ws.Range("B:B"), 1)
lRow = .Match(lCount, ws.Range("B:B"), False)
End With
MsgBox "Most Common Pair is " & ws.Range("A" & lRow) & " (" & lCount & "
occurrences)"

ws.Delete

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Sub MostCommonTriplet()
Dim rng As Range
Dim c As Range
Dim strTriplet As String
Dim ws As Worksheet
Dim lRow As Long
Dim lRow2 As Long
Dim lCount As Long

Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F"))

Application.ScreenUpdating = False
Application.DisplayAlerts = False

If Not rng Is Nothing Then
Set ws = ActiveWorkbook.Worksheets.Add
lRow = 1
For Each c In rng
If c.Column <= 4 Then
strTriplet = c.Value & "_" & c.Offset(0, 1).Value & "_" &
c.Offset(0, 2).Value

On Error Resume Next
lRow2 = Application.WorksheetFunction.Match(strTriplet,
ws.Range("A:A"), False)
If Err.Number 0 Then
ws.Range("A" & lRow).Value = strTriplet
ws.Range("B" & lRow).Value = 1
lRow = lRow + 1
Else
ws.Range("B" & lRow2).Value = ws.Range("B" &
lRow2).Value + 1
End If
On Error GoTo 0
End If
Next c
End If

'get the one with largest count
With Application.WorksheetFunction
lCount = .Large(ws.Range("B:B"), 1)
lRow = .Match(lCount, ws.Range("B:B"), False)
End With
MsgBox "Most Common Triplet is " & ws.Range("A" & lRow) & " (" & lCount
& " occurrences)"

ws.Delete

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

--
Hope that helps.

Vergel Adriano



" wrote:
Hi

I have been looking into this for few weeks now but I can't find a
solution ...

I have 200 rows of data composed of numbers from 1 to 10 on column A
to F.

I need to find out the most pair / triplet for the all table. Perhaps
the following example will explain better

1_2_3_4_5_6
1_2_5_6_7_9
2_3_5_6_7_8
3_4_6_7_8_9
1_3_5_6_7_8

Most common pair = 6_7
Most common triplet = 5_6_7

Hope this is clear ... thank you in advance

A- Hide quoted text -

- Show quoted text -

Hi Vergel Adriano,

Thanks VERY much for revised code, it is appreciated.
I had an idea after I posted my request.
It would be nice if the code could find the highest number in any of
the 6 number combinations using something like the Max worksheet
function and assigning it to a variable like maxVal for example. Then
we could calculate and list ALL the combinations of Pairs & Triplets
whether they have appeared or not along with the total occurances for
each. Obviously some of them will not have appeared as yet so will
show zero.
I know there are 1,176 Pairs of combinations for 6 from 49 and 18,424
Triplets for 6 from 49.
Would this be easy to do or would it make the processing time to
produce the results very long?.

Thanks in Advance.
All the Best.
Paul

On Aug 12, 5:06 pm, Vergel Adriano
wrote:
Hi Paul,

Give this a try.

Sub MostCommonPairAndTriplet()
Dim rng As Range
Dim c As Range
Dim strPair As String
Dim strTriplet As String
Dim wsResult As Worksheet
Dim lRow As Long
Dim lRow2 As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F"))

If Not rng Is Nothing Then

'Get the result worksheet
On Error Resume Next
Set wsResult = ActiveWorkbook.Worksheets("Results")
If wsResult Is Nothing Then
Set wsResult = ActiveWorkbook.Worksheets.Add
wsResult.Name = "Results"
Else
wsResult.UsedRange.Delete
End If
'column labels
With wsResult
.Range("B1").Value = "Value1"
.Range("C1").Value = "Value2"
.Range("D1").Value = "Count"
.Range("F1").Value = "Value1"
.Range("G1").Value = "Value2"
.Range("H1").Value = "Value3"
.Range("I1").Value = "Count"
End With
On Error GoTo 0

'Find Pairs
lRow = 2
For Each c In rng
If c.Column <= 5 Then
strPair = c.Value & "_" & c.Offset(0, 1).Value

On Error Resume Next
lRow2 = Application.WorksheetFunction.Match(strPair,
wsResult.Range("A:A"), False)
If Err.Number 0 Then
wsResult.Range("A" & lRow).Value = strPair
wsResult.Range("B" & lRow).Value = c.Value
wsResult.Range("C" & lRow).Value = c.Offset(0, 1).Value
wsResult.Range("D" & lRow).Value = 1
lRow = lRow + 1
Else
wsResult.Range("D" & lRow2).Value = wsResult.Range("D" &
lRow2).Value + 1
End If
On Error GoTo 0
End If
Next c

'Find Triplets
lRow = 2
For Each c In rng
If c.Column <= 4 Then
strTriplet = c.Value & "_" & c.Offset(0, 1).Value & "_" &
c.Offset(0, 2).Value

On Error Resume Next
lRow2 = Application.WorksheetFunction.Match(strTriplet,
wsResult.Range("E:E"), False)
If Err.Number 0 Then
wsResult.Range("E" & lRow).Value = strTriplet
wsResult.Range("F" & lRow).Value = c.Value
wsResult.Range("G" & lRow).Value = c.Offset(0, 1).Value
wsResult.Range("H" & lRow).Value = c.Offset(0, 2).Value
wsResult.Range("I" & lRow).Value = 1
lRow = lRow + 1
Else
wsResult.Range("I" & lRow2).Value = wsResult.Range("I" &
lRow2).Value + 1
End If
On Error GoTo 0
End If
Next c
End If

wsResult.Columns("E").Clear
wsResult.Columns("A").Delete

'Sort the pairs
With wsResult
.Columns("A:C").Sort Key1:=.Range("C2"), Order1:=xlDescending
.Columns("E:H").Sort Key1:=.Range("H2"), Order1:=xlDescending
End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

--
Hope that helps.

Vergel Adriano



"Paul Black" wrote:
Hi Vergel Adriano,

Sorry to jump in here A.
Would it be possible to adapt the codes so it outputs ALL the
combinations of Pairs & Triplets with the total amount of times they
have appeared please.
Maybe the results could go in a sheet named "Results" and :-
(1) The Pairs go in Cells "A1" & "B1" going down and the total times
appeared in Cell "C1" going down.
(2) The Triples go in Cells "E1", "F1" & "G1" going down and the total
times appeared in Cell "H1" going down.

Thanks in Advance.
All the Best.
Paul

On Aug 12, 12:28 am, Vergel Adriano
wrote:
maybe something like this:

Sub MostCommonPair()
Dim rng As Range
Dim c As Range
Dim strPair As String
Dim ws As Worksheet
Dim lRow As Long
Dim lRow2 As Long
Dim lCount As Long

Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F"))

Application.ScreenUpdating = False
Application.DisplayAlerts = False

If Not rng Is Nothing Then
Set ws = ActiveWorkbook.Worksheets.Add
lRow = 1
For Each c In rng
If c.Column <= 5 Then
strPair = c.Value & "_" & c.Offset(0, 1).Value

On Error Resume Next
lRow2 = Application.WorksheetFunction.Match(strPair,
ws.Range("A:A"), False)
If Err.Number 0 Then
ws.Range("A" & lRow).Value = strPair
ws.Range("B" & lRow).Value = 1
lRow = lRow + 1
Else
ws.Range("B" & lRow2).Value = ws.Range("B" &
lRow2).Value + 1
End If
On Error GoTo 0
End If
Next c
End If

'get the one with largest count
With Application.WorksheetFunction
lCount = .Large(ws.Range("B:B"), 1)
lRow = .Match(lCount, ws.Range("B:B"), False)
End With
MsgBox "Most Common Pair is " & ws.Range("A" & lRow) & " (" & lCount & "
occurrences)"

ws.Delete

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Sub MostCommonTriplet()
Dim rng As Range
Dim c As Range
Dim strTriplet As String
Dim ws As Worksheet
Dim lRow As Long
Dim lRow2 As Long
Dim lCount As Long

Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F"))

Application.ScreenUpdating = False
Application.DisplayAlerts = False

If Not rng Is Nothing Then
Set ws = ActiveWorkbook.Worksheets.Add
lRow = 1
For Each c In rng
If c.Column <= 4 Then
strTriplet = c.Value & "_" & c.Offset(0, 1).Value & "_" &
c.Offset(0, 2).Value

On Error Resume Next
lRow2 = Application.WorksheetFunction.Match(strTriplet,
ws.Range("A:A"), False)
If Err.Number 0 Then
ws.Range("A" & lRow).Value = strTriplet
ws.Range("B" & lRow).Value = 1
lRow = lRow + 1
Else
ws.Range("B" & lRow2).Value = ws.Range("B" &
lRow2).Value + 1
End If
On Error GoTo 0
End If
Next c
End If

'get the one with largest count
With Application.WorksheetFunction
lCount = .Large(ws.Range("B:B"), 1)
lRow = .Match(lCount, ws.Range("B:B"), False)
End With
MsgBox "Most Common Triplet is " & ws.Range("A" & lRow) & " (" & lCount
& " occurrences)"

ws.Delete

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

--
Hope that helps.

Vergel Adriano

" wrote:
Hi

I have been looking into this for few weeks now but I can't find a
solution ...

I have 200 rows of data composed of numbers from 1 to 10 on column A
to F.

I need to find out the most pair / triplet for the all table. Perhaps
the following example will explain better

1_2_3_4_5_6
1_2_5_6_7_9
2_3_5_6_7_8
3_4_6_7_8_9
1_3_5_6_7_8

Most common pair = 6_7
Most common triplet = 5_6_7

Hope this is clear ... thank you in advance

A- Hide quoted text -

- Show quoted text -- Hide quoted text -

- Show quoted text -

You could take some of your Lotto winnings and buy an Excel
textbook ;)


On Aug 12, 2:40 pm, Paul Black wrote:
Hi Vergel Adriano,

Thanks VERY much for revised code, it is appreciated.
I had an idea after I posted my request.
It would be nice if the code could find the highest number in any of
the 6 number combinations using something like the Max worksheet
function and assigning it to a variable like maxVal for example. Then
we could calculate and list ALL the combinations of Pairs & Triplets
whether they have appeared or not along with the total occurances for
each. Obviously some of them will not have appeared as yet so will
show zero.
I know there are 1,176 Pairs of combinations for 6 from 49 and 18,424
Triplets for 6 from 49.
Would this be easy to do or would it make the processing time to
produce the results very long?.

Thanks in Advance.
All the Best.
Paul

On Aug 12, 5:06 pm, Vergel Adriano





wrote:
Hi Paul,

Give this a try.

Sub MostCommonPairAndTriplet()
Dim rng As Range
Dim c As Range
Dim strPair As String
Dim strTriplet As String
Dim wsResult As Worksheet
Dim lRow As Long
Dim lRow2 As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F"))

If Not rng Is Nothing Then

'Get the result worksheet
On Error Resume Next
Set wsResult = ActiveWorkbook.Worksheets("Results")
If wsResult Is Nothing Then
Set wsResult = ActiveWorkbook.Worksheets.Add
wsResult.Name = "Results"
Else
wsResult.UsedRange.Delete
End If
'column labels
With wsResult
.Range("B1").Value = "Value1"
.Range("C1").Value = "Value2"
.Range("D1").Value = "Count"
.Range("F1").Value = "Value1"
.Range("G1").Value = "Value2"
.Range("H1").Value = "Value3"
.Range("I1").Value = "Count"
End With
On Error GoTo 0

'Find Pairs
lRow = 2
For Each c In rng
If c.Column <= 5 Then
strPair = c.Value & "_" & c.Offset(0, 1).Value

On Error Resume Next
lRow2 = Application.WorksheetFunction.Match(strPair,
wsResult.Range("A:A"), False)
If Err.Number 0 Then
wsResult.Range("A" & lRow).Value = strPair
wsResult.Range("B" & lRow).Value = c.Value
wsResult.Range("C" & lRow).Value = c.Offset(0, 1).Value
wsResult.Range("D" & lRow).Value = 1
lRow = lRow + 1
Else
wsResult.Range("D" & lRow2).Value = wsResult.Range("D" &
lRow2).Value + 1
End If
On Error GoTo 0
End If
Next c

'Find Triplets
lRow = 2
For Each c In rng
If c.Column <= 4 Then
strTriplet = c.Value & "_" & c.Offset(0, 1).Value & "_" &
c.Offset(0, 2).Value

On Error Resume Next
lRow2 = Application.WorksheetFunction.Match(strTriplet,
wsResult.Range("E:E"), False)
If Err.Number 0 Then
wsResult.Range("E" & lRow).Value = strTriplet
wsResult.Range("F" & lRow).Value = c.Value
wsResult.Range("G" & lRow).Value = c.Offset(0, 1).Value
wsResult.Range("H" & lRow).Value = c.Offset(0, 2).Value
wsResult.Range("I" & lRow).Value = 1
lRow = lRow + 1
Else
wsResult.Range("I" & lRow2).Value = wsResult.Range("I" &
lRow2).Value + 1
End If
On Error GoTo 0
End If
Next c
End If

wsResult.Columns("E").Clear
wsResult.Columns("A").Delete

'Sort the pairs
With wsResult
.Columns("A:C").Sort Key1:=.Range("C2"), Order1:=xlDescending
.Columns("E:H").Sort Key1:=.Range("H2"), Order1:=xlDescending
End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

--
Hope that helps.

Vergel Adriano

"Paul Black" wrote:
Hi Vergel Adriano,

Sorry to jump in here A.
Would it be possible to adapt the codes so it outputs ALL the
combinations of Pairs & Triplets with the total amount of times they
have appeared please.
Maybe the results could go in a sheet named "Results" and :-
(1) The Pairs go in Cells "A1" & "B1" going down and the total times
appeared in Cell "C1" going down.
(2) The Triples go in Cells "E1", "F1" & "G1" going down and the total
times appeared in Cell "H1" going down.

Thanks in Advance.
All the Best.
Paul

On Aug 12, 12:28 am, Vergel Adriano
wrote:
maybe something like this:

Sub MostCommonPair()
Dim rng As Range
Dim c As Range
Dim strPair As String
Dim ws As Worksheet
Dim lRow As Long
Dim lRow2 As Long
Dim lCount As Long

Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F"))

Application.ScreenUpdating = False
Application.DisplayAlerts = False

If Not rng Is Nothing Then
Set ws = ActiveWorkbook.Worksheets.Add
lRow = 1
For Each c In rng
If c.Column <= 5 Then
strPair = c.Value & "_" & c.Offset(0, 1).Value

On Error Resume Next
lRow2 = Application.WorksheetFunction.Match(strPair,
ws.Range("A:A"), False)
If Err.Number 0 Then
ws.Range("A" & lRow).Value = strPair
ws.Range("B" & lRow).Value = 1
lRow = lRow + 1
Else
ws.Range("B" & lRow2).Value = ws.Range("B" &
lRow2).Value + 1
End If
On Error GoTo 0
End If
Next c
End If

'get the one with largest count
With Application.WorksheetFunction
lCount = .Large(ws.Range("B:B"), 1)
lRow = .Match(lCount, ws.Range("B:B"), False)
End With
MsgBox "Most Common Pair is " & ws.Range("A" & lRow) & " (" & lCount & "
occurrences)"

ws.Delete

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Sub MostCommonTriplet()
Dim rng As Range
Dim c As Range
Dim strTriplet As String
Dim ws As Worksheet
Dim lRow As Long
Dim lRow2 As Long
Dim lCount As Long

Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F"))

Application.ScreenUpdating = False
Application.DisplayAlerts = False

If Not rng Is Nothing Then
Set ws = ActiveWorkbook.Worksheets.Add
lRow = 1
For Each c In rng
If c.Column <= 4 Then
strTriplet = c.Value & "_" & c.Offset(0, 1).Value & "_" &
c.Offset(0, 2).Value

On Error Resume Next
lRow2 = Application.WorksheetFunction.Match(strTriplet,
ws.Range("A:A"), False)
If Err.Number 0 Then
ws.Range("A" & lRow).Value = strTriplet
ws.Range("B" & lRow).Value = 1
lRow = lRow + 1
Else
ws.Range("B" & lRow2).Value = ws.Range("B" &
lRow2).Value + 1
End If
On Error GoTo 0
End If
Next c
End If

'get the one with largest count
With Application.WorksheetFunction
lCount = .Large(ws.Range("B:B"), 1)
lRow = .Match(lCount, ws.Range("B:B"), False)
End With
MsgBox "Most Common Triplet is " & ws.Range("A" & lRow) & " (" & lCount
& " occurrences)"

ws.Delete

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

--
Hope that helps.

Vergel Adriano

" wrote:
Hi

I have been looking into this for few weeks now but I can't find a
solution ...

I have 200 rows of data composed of numbers from 1 to 10 on column A
to F.

I need to find out the most pair / triplet for the all table. Perhaps
the following example will explain better

1_2_3_4_5_6
1_2_5_6_7_9
2_3_5_6_7_8
3_4_6_7_8_9
1_3_5_6_7_8

Most common pair = 6_7
Most common triplet = 5_6_7

Hope this is clear ... thank you in advance

A- Hide quoted text -

- Show quoted text -- Hide quoted text -

- Show quoted text -

I'm not sure I understood what you're wanting to do... Perhaps you'll need to
explain a little further. Are you saying the 6 numbers can be a number from
1 to 49 and you want to list all possible pairs and triplets? By my
calculation, there will be 2,401 pairs and 117,649 triplets... The pairs
won't be much of a problem but the triplets go over 65,000 so it will need to
be split.. but again, maybe I'm not fully understanding the question..


Sub test()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim lCount As Long

lCount = 0
For i = 1 To 49
For j = 1 To 49
lCount = lCount + 1
Next j
Next i
MsgBox lCount & " pairs"

lCount = 0
For i = 1 To 49
For j = 1 To 49
For k = 1 To 49
lCount = lCount + 1
Next k
Next j
Next i

MsgBox lCount & " triplets"

End Sub



--
Hope that helps.

Vergel Adriano


"Paul Black" wrote:

Hi Vergel Adriano,

Thanks VERY much for revised code, it is appreciated.
I had an idea after I posted my request.
It would be nice if the code could find the highest number in any of
the 6 number combinations using something like the Max worksheet
function and assigning it to a variable like maxVal for example. Then
we could calculate and list ALL the combinations of Pairs & Triplets
whether they have appeared or not along with the total occurances for
each. Obviously some of them will not have appeared as yet so will
show zero.
I know there are 1,176 Pairs of combinations for 6 from 49 and 18,424
Triplets for 6 from 49.
Would this be easy to do or would it make the processing time to
produce the results very long?.

Thanks in Advance.
All the Best.
Paul

On Aug 12, 5:06 pm, Vergel Adriano
wrote:
Hi Paul,

Give this a try.

Sub MostCommonPairAndTriplet()
Dim rng As Range
Dim c As Range
Dim strPair As String
Dim strTriplet As String
Dim wsResult As Worksheet
Dim lRow As Long
Dim lRow2 As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F"))

If Not rng Is Nothing Then

'Get the result worksheet
On Error Resume Next
Set wsResult = ActiveWorkbook.Worksheets("Results")
If wsResult Is Nothing Then
Set wsResult = ActiveWorkbook.Worksheets.Add
wsResult.Name = "Results"
Else
wsResult.UsedRange.Delete
End If
'column labels
With wsResult
.Range("B1").Value = "Value1"
.Range("C1").Value = "Value2"
.Range("D1").Value = "Count"
.Range("F1").Value = "Value1"
.Range("G1").Value = "Value2"
.Range("H1").Value = "Value3"
.Range("I1").Value = "Count"
End With
On Error GoTo 0

'Find Pairs
lRow = 2
For Each c In rng
If c.Column <= 5 Then
strPair = c.Value & "_" & c.Offset(0, 1).Value

On Error Resume Next
lRow2 = Application.WorksheetFunction.Match(strPair,
wsResult.Range("A:A"), False)
If Err.Number 0 Then
wsResult.Range("A" & lRow).Value = strPair
wsResult.Range("B" & lRow).Value = c.Value
wsResult.Range("C" & lRow).Value = c.Offset(0, 1).Value
wsResult.Range("D" & lRow).Value = 1
lRow = lRow + 1
Else
wsResult.Range("D" & lRow2).Value = wsResult.Range("D" &
lRow2).Value + 1
End If
On Error GoTo 0
End If
Next c

'Find Triplets
lRow = 2
For Each c In rng
If c.Column <= 4 Then
strTriplet = c.Value & "_" & c.Offset(0, 1).Value & "_" &
c.Offset(0, 2).Value

On Error Resume Next
lRow2 = Application.WorksheetFunction.Match(strTriplet,
wsResult.Range("E:E"), False)
If Err.Number 0 Then
wsResult.Range("E" & lRow).Value = strTriplet
wsResult.Range("F" & lRow).Value = c.Value
wsResult.Range("G" & lRow).Value = c.Offset(0, 1).Value
wsResult.Range("H" & lRow).Value = c.Offset(0, 2).Value
wsResult.Range("I" & lRow).Value = 1
lRow = lRow + 1
Else
wsResult.Range("I" & lRow2).Value = wsResult.Range("I" &
lRow2).Value + 1
End If
On Error GoTo 0
End If
Next c
End If

wsResult.Columns("E").Clear
wsResult.Columns("A").Delete

'Sort the pairs
With wsResult
.Columns("A:C").Sort Key1:=.Range("C2"), Order1:=xlDescending
.Columns("E:H").Sort Key1:=.Range("H2"), Order1:=xlDescending
End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

--
Hope that helps.

Vergel Adriano



"Paul Black" wrote:
Hi Vergel Adriano,

Sorry to jump in here A.
Would it be possible to adapt the codes so it outputs ALL the
combinations of Pairs & Triplets with the total amount of times they
have appeared please.
Maybe the results could go in a sheet named "Results" and :-
(1) The Pairs go in Cells "A1" & "B1" going down and the total times
appeared in Cell "C1" going down.
(2) The Triples go in Cells "E1", "F1" & "G1" going down and the total
times appeared in Cell "H1" going down.

Thanks in Advance.
All the Best.
Paul

On Aug 12, 12:28 am, Vergel Adriano
wrote:
maybe something like this:

Sub MostCommonPair()
Dim rng As Range
Dim c As Range
Dim strPair As String
Dim ws As Worksheet
Dim lRow As Long
Dim lRow2 As Long
Dim lCount As Long

Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F"))

Application.ScreenUpdating = False
Application.DisplayAlerts = False

If Not rng Is Nothing Then
Set ws = ActiveWorkbook.Worksheets.Add
lRow = 1
For Each c In rng
If c.Column <= 5 Then
strPair = c.Value & "_" & c.Offset(0, 1).Value

On Error Resume Next
lRow2 = Application.WorksheetFunction.Match(strPair,
ws.Range("A:A"), False)
If Err.Number 0 Then
ws.Range("A" & lRow).Value = strPair
ws.Range("B" & lRow).Value = 1
lRow = lRow + 1
Else
ws.Range("B" & lRow2).Value = ws.Range("B" &
lRow2).Value + 1
End If
On Error GoTo 0
End If
Next c
End If

'get the one with largest count
With Application.WorksheetFunction
lCount = .Large(ws.Range("B:B"), 1)
lRow = .Match(lCount, ws.Range("B:B"), False)
End With
MsgBox "Most Common Pair is " & ws.Range("A" & lRow) & " (" & lCount & "
occurrences)"

ws.Delete

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Sub MostCommonTriplet()
Dim rng As Range
Dim c As Range
Dim strTriplet As String
Dim ws As Worksheet
Dim lRow As Long
Dim lRow2 As Long
Dim lCount As Long

Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F"))

Application.ScreenUpdating = False
Application.DisplayAlerts = False

If Not rng Is Nothing Then
Set ws = ActiveWorkbook.Worksheets.Add
lRow = 1
For Each c In rng
If c.Column <= 4 Then
strTriplet = c.Value & "_" & c.Offset(0, 1).Value & "_" &
c.Offset(0, 2).Value

On Error Resume Next
lRow2 = Application.WorksheetFunction.Match(strTriplet,
ws.Range("A:A"), False)
If Err.Number 0 Then
ws.Range("A" & lRow).Value = strTriplet
ws.Range("B" & lRow).Value = 1
lRow = lRow + 1
Else
ws.Range("B" & lRow2).Value = ws.Range("B" &
lRow2).Value + 1
End If
On Error GoTo 0
End If
Next c
End If

'get the one with largest count
With Application.WorksheetFunction
lCount = .Large(ws.Range("B:B"), 1)
lRow = .Match(lCount, ws.Range("B:B"), False)
End With
MsgBox "Most Common Triplet is " & ws.Range("A" & lRow) & " (" & lCount
& " occurrences)"

ws.Delete

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

--
Hope that helps.

Vergel Adriano

" wrote:
Hi

I have been looking into this for few weeks now but I can't find a
solution ...

I have 200 rows of data composed of numbers from 1 to 10 on column A
to F.

I need to find out the most pair / triplet for the all table. Perhaps
the following example will explain better

1_2_3_4_5_6
1_2_5_6_7_9
2_3_5_6_7_8
3_4_6_7_8_9
1_3_5_6_7_8

Most common pair = 6_7
Most common triplet = 5_6_7

Hope this is clear ... thank you in advance

A- Hide quoted text -

- Show quoted text -- Hide quoted text -

- Show quoted text -