|
How to find the most common pair and triplet numbers?
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 |
How to find the most common pair and triplet numbers?
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 |
How to find the most common pair and triplet numbers?
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 |
How to find the most common pair and triplet numbers?
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 - |
How to find the most common pair and triplet numbers?
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 - |
How to find the most common pair and triplet numbers?
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 - |
How to find the most common pair and triplet numbers?
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 - |
How to find the most common pair and triplet numbers?
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 - |
How to find the most common pair and triplet numbers?
Hi Vergel Adriano, thanks for the reply.
Please ignore my previous post. I did some calculations and came to the conclusion that there would be no advantage in listing ALL combinations of Pairs or Triplets for those that have and haven't appeared, especially with consideration to the processing time, which I think would be extreme. Anyway, I do not have access to Excel for a couple of days so I would just like to ask a couple of questions please with regard to your following code. I am new to VBA so please be patient with me. On Aug 13, 3:50 am, Vergel Adriano wrote: On Aug 12, 5:06 pm, Vergel Adriano 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 ( 1 ) If ALL the 6 number combinations are in a sheet named "Input" and in Cells "B3:G?" ( I use "G?" because the row number will obviously change as more 6 number combinations are entered ), could we use instead of ... Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F")) .... something like ... Set rng = Intersect(Worksheets("Input").Range("B3:G" & Range("B3").End(xlDown).Row .... to set the range for ALL 6 number combinations?. Do we also need to "Select" the "Input" sheet somewhere in the code?. ( 2 ) What if ... Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F")) .... or ... Set rng = Intersect(Worksheets("Input").Range("B3:G" & Range("B3").End(xlDown).Row .... has no data, could we insert something like ... If rng Is Nothing Then Exit Sub .... or such like?. ( 3 ) Could you please explain what the Dim variables ... c lRow Irow2 .... actaually do please. ( 4 ) What for the Pairs does this actually mean and do please ... If c.Column <= 5 Then Thanks VERY much in Advance. All the Best. Paul |
How to find the most common pair and triplet numbers?
Hi Paul,
(1) No, you won't need to select or activate the Input sheet. You usually can work with a worksheet or range without selecting it. You can try something like this: With Worksheets("Input") Set rng = .Range("B3:G3").End(xlDown) End With (2) Yes, you can validate if rng has no data. But since you're starting with B3:G3, rng will never be equal to Nothing. What you can do is count numeric values and if you get anything greater than 0 then it means you have some data to work with. Something like this: If Application.WorksheetFunction.Count(rng) 0 Then 'do something End If (3) In the code that I gave, c is a range variable that I used to loop through the individual cells in the data range, lRow is a Long variable that I used to keep track of the next available row in the "Results" worksheet and lRow2 is also a Long variable that I used to determine the row number of a pair or triplet that already exists in the Results worksheet. If the call to the Match worksheetfunction does not result in error, then it means lRow2 would have the row number in Results for the current pair or triplet being tested. (4) In the code "If c.Column <= 5", 5 means column E. Because in my example, the data is in columns A to F, then I can only have a pair for values in columns A to E. If the cell is in column F (i.e., column=6) then, the code should not do anything. In your case, since you're doing it for data in columns B to G, you'll want to change the 5 to 6 for pairs and use 5 instead of 4 for triplets. -- Hope that helps. Vergel Adriano "Paul Black" wrote: Hi Vergel Adriano, thanks for the reply. Please ignore my previous post. I did some calculations and came to the conclusion that there would be no advantage in listing ALL combinations of Pairs or Triplets for those that have and haven't appeared, especially with consideration to the processing time, which I think would be extreme. Anyway, I do not have access to Excel for a couple of days so I would just like to ask a couple of questions please with regard to your following code. I am new to VBA so please be patient with me. On Aug 13, 3:50 am, Vergel Adriano wrote: On Aug 12, 5:06 pm, Vergel Adriano 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 ( 1 ) If ALL the 6 number combinations are in a sheet named "Input" and in Cells "B3:G?" ( I use "G?" because the row number will obviously change as more 6 number combinations are entered ), could we use instead of ... Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F")) .... something like ... Set rng = Intersect(Worksheets("Input").Range("B3:G" & Range("B3").End(xlDown).Row .... to set the range for ALL 6 number combinations?. Do we also need to "Select" the "Input" sheet somewhere in the code?. ( 2 ) What if ... Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F")) .... or ... Set rng = Intersect(Worksheets("Input").Range("B3:G" & Range("B3").End(xlDown).Row .... has no data, could we insert something like ... If rng Is Nothing Then Exit Sub .... or such like?. ( 3 ) Could you please explain what the Dim variables ... c lRow Irow2 .... actaually do please. ( 4 ) What for the Pairs does this actually mean and do please ... If c.Column <= 5 Then Thanks VERY much in Advance. All the Best. Paul |
How to find the most common pair and triplet numbers?
Hi Vergel Adriano,
I have just run your posted code and it is not giving the correct results for either Pairs or Triplets. I put 2 combinations in a sheet in Cells "A1:F2" which were :- 1 2 3 4 5 6 1 2 3 4 5 7 The results for "Pairs" should be ... 3 , 6 = 4 Occurances 5 , 6 = 4 Occurances 6 , 7 = 4 Occurances 1 , 5 = 3 Occurances 2 , 5 = 3 Occurances 2 , 6 = 3 Occurances 3 , 5 = 3 Occurances 3 , 7 = 3 Occurances 3 , 8 = 3 Occurances 5 , 7 = 3 Occurances 6 , 8 = 3 Occurances 7 , 8 = 3 Occurances 1 , 2 = 2 Occurances 1 , 3 = 2 Occurances 1 , 6 = 2 Occurances 1 , 7 = 2 Occurances 2 , 3 = 2 Occurances 2 , 7 = 2 Occurances 3 , 4 = 2 Occurances 4 , 6 = 2 Occurances 5 , 8 = 2 Occurances 6 , 9 = 2 Occurances 7 , 9 = 2 Occurances 1 , 4 = 1 Occurances 1 , 8 = 1 Occurances 1 , 9 = 1 Occurances 2 , 4 = 1 Occurances 2 , 8 = 1 Occurances 2 , 9 = 1 Occurances 3 , 9 = 1 Occurances 4 , 5 = 1 Occurances 4 , 7 = 1 Occurances 4 , 8 = 1 Occurances 4 , 9 = 1 Occurances 5 , 9 = 1 Occurances 8 , 9 = 1 Occurances .... but your code produced ... V1 V2 Cnt 1 2 2 2 3 2 3 4 2 4 5 2 5 6 1 .... results. I can't work out why the program is not listing ALL the pairs and the total occurances. Thanks for your help. All the Best. Paul On Aug 13, 2:38 pm, Vergel Adriano wrote: Hi Paul, (1) No, you won't need to select or activate the Input sheet. You usually can work with a worksheet or range without selecting it. You can try something like this: With Worksheets("Input") Set rng = .Range("B3:G3").End(xlDown) End With (2) Yes, you can validate if rng has no data. But since you're starting with B3:G3, rng will never be equal to Nothing. What you can do is count numeric values and if you get anything greater than 0 then it means you have some data to work with. Something like this: If Application.WorksheetFunction.Count(rng) 0 Then 'do something End If (3) In the code that I gave, c is a range variable that I used to loop through the individual cells in the data range, lRow is a Long variable that I used to keep track of the next available row in the "Results" worksheet and lRow2 is also a Long variable that I used to determine the row number of a pair or triplet that already exists in the Results worksheet. If the call to the Match worksheetfunction does not result in error, then it means lRow2 would have the row number in Results for the current pair or triplet being tested. (4) In the code "If c.Column <= 5", 5 means column E. Because in my example, the data is in columns A to F, then I can only have a pair for values in columns A to E. If the cell is in column F (i.e., column=6) then, the code should not do anything. In your case, since you're doing it for data in columns B to G, you'll want to change the 5 to 6 for pairs and use 5 instead of 4 for triplets. -- Hope that helps. Vergel Adriano "Paul Black" wrote: Hi Vergel Adriano, thanks for the reply. Please ignore my previous post. I did some calculations and came to the conclusion that there would be no advantage in listing ALL combinations of Pairs or Triplets for those that have and haven't appeared, especially with consideration to the processing time, which I think would be extreme. Anyway, I do not have access to Excel for a couple of days so I would just like to ask a couple of questions please with regard to your following code. I am new to VBA so please be patient with me. On Aug 13, 3:50 am, Vergel Adriano wrote: On Aug 12, 5:06 pm, Vergel Adriano 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 ( 1 ) If ALL the 6 number combinations are in a sheet named "Input" and in Cells "B3:G?" ( I use "G?" because the row number will obviously change as more 6 number combinations are entered ), could we use instead of ... Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F")) .... something like ... Set rng = Intersect(Worksheets("Input").Range("B3:G" & Range("B3").End(xlDown).Row .... to set the range for ALL 6 number combinations?. Do we also need to "Select" the "Input" sheet somewhere in the code?. ( 2 ) What if ... Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F")) .... or ... Set rng = Intersect(Worksheets("Input").Range("B3:G" & Range("B3").End(xlDown).Row .... has no data, could we insert something like ... If rng Is Nothing Then Exit Sub .... or such like?. ( 3 ) Could you please explain what the Dim variables ... c lRow Irow2 .... actaually do please. ( 4 ) What for the Pairs does this actually mean and do please ... If c.Column <= 5 Then Thanks VERY much in Advance. All the Best. Paul- Hide quoted text - - Show quoted text - |
How to find the most common pair and triplet numbers?
Paul wrote:
Sorry to jump in here.. me too Paul wrote: I have just run your posted code and it is not giving the correct results for either Pairs or Triplets. I put 2 combinations in a sheet in Cells "A1:F2" which were :- 1 2 3 4 5 6 1 2 3 4 5 7 The results for "Pairs" should be ... .. 1 , 9 = 1 Occurances .. How can 1,9 be a pair occurance when there is no 9? ----== Posted via Newsfeeds.Com - Unlimited-Unrestricted-Secure Usenet News==---- http://www.newsfeeds.com The #1 Newsgroup Service in the World! 120,000+ Newsgroups ----= East and West-Coast Server Farms - Total Privacy via Encryption =---- |
How to find the most common pair and triplet numbers?
Well spotted Dave D-C,
The actual results for Pairs should be as follows ... 1 , 2 = 2 Occurances 1 , 3 = 2 Occurances 1 , 4 = 2 Occurances 1 , 5 = 2 Occurances 1 , 6 = 1 Occurances 1 , 7 = 1 Occurances 2 , 3 = 2 Occurances 2 , 4 = 2 Occurances 2 , 5 = 2 Occurances 2 , 6 = 1 Occurances 2 , 7 = 1 Occurances 3 , 4 = 2 Occurances 3 , 5 = 2 Occurances 3 , 6 = 1 Occurances 3 , 7 = 1 Occurances 4 , 5 = 2 Occurances 4 , 6 = 1 Occurances 4 , 7 = 1 Occurances 5 , 6 = 1 Occurances 5 , 7 = 1 Occurances 6 , 7 = 0 Occurances .... NOT as previously stated. Your code Vergel Adriano produced ... V1 V2 Cnt 1 2 2 2 3 2 3 4 2 4 5 2 5 6 1 Thanks in Advance. All the Best. Paul On Aug 14, 4:41 pm, Dave D-C wrote: Paul wrote: Sorry to jump in here.. me too Paul wrote: I have just run your posted code and it is not giving the correct results for either Pairs or Triplets. I put 2 combinations in a sheet in Cells "A1:F2" which were :- 1 2 3 4 5 6 1 2 3 4 5 7 The results for "Pairs" should be ... .. 1 , 9 = 1 Occurances .. How can 1,9 be a pair occurance when there is no 9? ----== Posted via Newsfeeds.Com - Unlimited-Unrestricted-Secure Usenet News==----http://www.newsfeeds.comThe #1 Newsgroup Service in the World! 120,000+ Newsgroups ----= East and West-Coast Server Farms - Total Privacy via Encryption =---- |
How to find the most common pair and triplet numbers?
I think this is what you're looking for.
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 Dim i As Integer Dim j As Integer 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 For i = 1 To 6 - c.Column strPair = c.Value & "_" & c.Offset(0, i).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, i).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 Next i End If Next c 'Find Triplets lRow = 2 For Each c In rng If c.Column <= 5 Then For i = 1 To 6 - c.Column For j = 1 To 6 - c.Offset(0, i).Column strTriplet = c.Value & "_" & c.Offset(0, i).Value & "_" & c.Offset(0, i + j).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, i).Value wsResult.Range("H" & lRow).Value = c.Offset(0, i + j).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 Next j Next i 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: Well spotted Dave D-C, The actual results for Pairs should be as follows ... 1 , 2 = 2 Occurances 1 , 3 = 2 Occurances 1 , 4 = 2 Occurances 1 , 5 = 2 Occurances 1 , 6 = 1 Occurances 1 , 7 = 1 Occurances 2 , 3 = 2 Occurances 2 , 4 = 2 Occurances 2 , 5 = 2 Occurances 2 , 6 = 1 Occurances 2 , 7 = 1 Occurances 3 , 4 = 2 Occurances 3 , 5 = 2 Occurances 3 , 6 = 1 Occurances 3 , 7 = 1 Occurances 4 , 5 = 2 Occurances 4 , 6 = 1 Occurances 4 , 7 = 1 Occurances 5 , 6 = 1 Occurances 5 , 7 = 1 Occurances 6 , 7 = 0 Occurances .... NOT as previously stated. Your code Vergel Adriano produced ... V1 V2 Cnt 1 2 2 2 3 2 3 4 2 4 5 2 5 6 1 Thanks in Advance. All the Best. Paul On Aug 14, 4:41 pm, Dave D-C wrote: Paul wrote: Sorry to jump in here.. me too Paul wrote: I have just run your posted code and it is not giving the correct results for either Pairs or Triplets. I put 2 combinations in a sheet in Cells "A1:F2" which were :- 1 2 3 4 5 6 1 2 3 4 5 7 The results for "Pairs" should be ... .. 1 , 9 = 1 Occurances .. How can 1,9 be a pair occurance when there is no 9? ----== Posted via Newsfeeds.Com - Unlimited-Unrestricted-Secure Usenet News==----http://www.newsfeeds.comThe #1 Newsgroup Service in the World! 120,000+ Newsgroups ----= East and West-Coast Server Farms - Total Privacy via Encryption =---- |
How to find the most common pair and triplet numbers?
Thanks Vergel Adriano,
It is almost there. I ran your code this morning and it does indeed produce only the combinations that are relevant. The only thing is that it is not totally properly. It shows a count of 1 for all the combinations where some should be 2. I think it is calculating the totals purely on the first combination and then going onto the second combination, but there are the same combinations in both so the total should be 2. Thanks again for all your help and time on this, it is very much appreciated. All the Best. Paul On Aug 14, 11:48 pm, Vergel Adriano wrote: I think this is what you're looking for. 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 Dim i As Integer Dim j As Integer 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 For i = 1 To 6 - c.Column strPair = c.Value & "_" & c.Offset(0, i).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, i).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 Next i End If Next c 'Find Triplets lRow = 2 For Each c In rng If c.Column <= 5 Then For i = 1 To 6 - c.Column For j = 1 To 6 - c.Offset(0, i).Column strTriplet = c.Value & "_" & c.Offset(0, i).Value & "_" & c.Offset(0, i + j).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, i).Value wsResult.Range("H" & lRow).Value = c.Offset(0, i + j).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 Next j Next i 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: Well spotted Dave D-C, The actual results for Pairs should be as follows ... 1 , 2 = 2 Occurances 1 , 3 = 2 Occurances 1 , 4 = 2 Occurances 1 , 5 = 2 Occurances 1 , 6 = 1 Occurances 1 , 7 = 1 Occurances 2 , 3 = 2 Occurances 2 , 4 = 2 Occurances 2 , 5 = 2 Occurances 2 , 6 = 1 Occurances 2 , 7 = 1 Occurances 3 , 4 = 2 Occurances 3 , 5 = 2 Occurances 3 , 6 = 1 Occurances 3 , 7 = 1 Occurances 4 , 5 = 2 Occurances 4 , 6 = 1 Occurances 4 , 7 = 1 Occurances 5 , 6 = 1 Occurances 5 , 7 = 1 Occurances 6 , 7 = 0 Occurances .... NOT as previously stated. Your code Vergel Adriano produced ... V1 V2 Cnt 1 2 2 2 3 2 3 4 2 4 5 2 5 6 1 Thanks in Advance. All the Best. Paul On Aug 14, 4:41 pm, Dave D-C wrote: Paul wrote: Sorry to jump in here.. me too Paul wrote: I have just run your posted code and it is not giving the correct results for either Pairs or Triplets. I put 2 combinations in a sheet in Cells "A1:F2" which were :- 1 2 3 4 5 6 1 2 3 4 5 7 The results for "Pairs" should be ... .. 1 , 9 = 1 Occurances .. How can 1,9 be a pair occurance when there is no 9? ----== Posted via Newsfeeds.Com - Unlimited-Unrestricted-Secure Usenet News==----http://www.newsfeeds.comThe#1 Newsgroup Service in the World! 120,000+ Newsgroups ----= East and West-Coast Server Farms - Total Privacy via Encryption =----- Hide quoted text - - Show quoted text - |
How to find the most common pair and triplet numbers?
Paul,
I used the sample data that you gave and the code produced the same result that you identified. So, with this data in A1:F2: 1 2 3 4 5 6 1 2 3 4 5 7 can you tell me for which pair the code is giving a count of 1 but should be 2? -- Hope that helps. Vergel Adriano "Paul Black" wrote: Thanks Vergel Adriano, It is almost there. I ran your code this morning and it does indeed produce only the combinations that are relevant. The only thing is that it is not totally properly. It shows a count of 1 for all the combinations where some should be 2. I think it is calculating the totals purely on the first combination and then going onto the second combination, but there are the same combinations in both so the total should be 2. Thanks again for all your help and time on this, it is very much appreciated. All the Best. Paul On Aug 14, 11:48 pm, Vergel Adriano wrote: I think this is what you're looking for. 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 Dim i As Integer Dim j As Integer 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 For i = 1 To 6 - c.Column strPair = c.Value & "_" & c.Offset(0, i).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, i).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 Next i End If Next c 'Find Triplets lRow = 2 For Each c In rng If c.Column <= 5 Then For i = 1 To 6 - c.Column For j = 1 To 6 - c.Offset(0, i).Column strTriplet = c.Value & "_" & c.Offset(0, i).Value & "_" & c.Offset(0, i + j).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, i).Value wsResult.Range("H" & lRow).Value = c.Offset(0, i + j).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 Next j Next i 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: Well spotted Dave D-C, The actual results for Pairs should be as follows ... 1 , 2 = 2 Occurances 1 , 3 = 2 Occurances 1 , 4 = 2 Occurances 1 , 5 = 2 Occurances 1 , 6 = 1 Occurances 1 , 7 = 1 Occurances 2 , 3 = 2 Occurances 2 , 4 = 2 Occurances 2 , 5 = 2 Occurances 2 , 6 = 1 Occurances 2 , 7 = 1 Occurances 3 , 4 = 2 Occurances 3 , 5 = 2 Occurances 3 , 6 = 1 Occurances 3 , 7 = 1 Occurances 4 , 5 = 2 Occurances 4 , 6 = 1 Occurances 4 , 7 = 1 Occurances 5 , 6 = 1 Occurances 5 , 7 = 1 Occurances 6 , 7 = 0 Occurances .... NOT as previously stated. Your code Vergel Adriano produced ... V1 V2 Cnt 1 2 2 2 3 2 3 4 2 4 5 2 5 6 1 Thanks in Advance. All the Best. Paul On Aug 14, 4:41 pm, Dave D-C wrote: Paul wrote: Sorry to jump in here.. me too Paul wrote: I have just run your posted code and it is not giving the correct results for either Pairs or Triplets. I put 2 combinations in a sheet in Cells "A1:F2" which were :- 1 2 3 4 5 6 1 2 3 4 5 7 The results for "Pairs" should be ... .. 1 , 9 = 1 Occurances .. How can 1,9 be a pair occurance when there is no 9? ----== Posted via Newsfeeds.Com - Unlimited-Unrestricted-Secure Usenet News==----http://www.newsfeeds.comThe#1 Newsgroup Service in the World! 120,000+ Newsgroups ----= East and West-Coast Server Farms - Total Privacy via Encryption =----- Hide quoted text - - Show quoted text - |
How to find the most common pair and triplet numbers?
Hi Vergel Adriano,
It comes up with an ERROR on the line ... wsResult.Range("D" & lRow2).Value =wsResult.Range("D" & lRow2).Value 1 .... for both Pairs & Triplets, but if you remove the 1 at the end it appears to be OK. Your program for combinations ... 1 2 3 4 5 6 1 2 3 4 5 7 .... produces the results ... 1 , 2 = 1 1 , 3 = 1 1 , 4 = 1 1 , 5 = 1 1 , 6 = 1 2 , 3 = 1 2 , 4 = 1 2 , 5 = 1 2 , 6 = 1 3 , 4 = 1 3 , 5 = 1 3 , 6 = 1 4 , 5 = 1 4 , 6 = 1 5 , 6 = 1 1 , 7 = 1 2 , 7 = 1 3 , 7 = 1 4 , 7 = 1 5 , 7 = 1 .... where it should be ... 1 , 2 = 2 1 , 3 = 2 1 , 4 = 2 1 , 5 = 2 1 , 6 = 1 2 , 3 = 2 2 , 4 = 2 2 , 5 = 2 2 , 6 = 1 3 , 4 = 2 3 , 5 = 2 3 , 6 = 1 4 , 5 = 2 4 , 6 = 1 5 , 6 = 1 1 , 7 = 1 2 , 7 = 1 3 , 7 = 1 4 , 7 = 1 5 , 7 = 1 .... because some Pairs are in BOTH combinations. This would obviously be more if there were more than 2 combinations to evaluate. Thanks in Advance. All the Best. Paul On Aug 15, 3:32 pm, Vergel Adriano wrote: Paul, I used the sample data that you gave and the code produced the same result that you identified. So, with this data in A1:F2: 1 2 3 4 5 6 1 2 3 4 5 7 can you tell me for which pair the code is giving a count of 1 but should be 2? -- Hope that helps. Vergel Adriano "Paul Black" wrote: Thanks Vergel Adriano, It is almost there. I ran your code this morning and it does indeed produce only the combinations that are relevant. The only thing is that it is not totally properly. It shows a count of 1 for all the combinations where some should be 2. I think it is calculating the totals purely on the first combination and then going onto the second combination, but there are the same combinations in both so the total should be 2. Thanks again for all your help and time on this, it is very much appreciated. All the Best. Paul On Aug 14, 11:48 pm, Vergel Adriano wrote: I think this is what you're looking for. 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 Dim i As Integer Dim j As Integer 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 For i = 1 To 6 - c.Column strPair = c.Value & "_" & c.Offset(0, i).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, i).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 Next i End If Next c 'Find Triplets lRow = 2 For Each c In rng If c.Column <= 5 Then For i = 1 To 6 - c.Column For j = 1 To 6 - c.Offset(0, i).Column strTriplet = c.Value & "_" & c.Offset(0, i).Value & "_" & c.Offset(0, i + j).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, i).Value wsResult.Range("H" & lRow).Value = c.Offset(0, i + j).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 Next j Next i 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: Well spotted Dave D-C, The actual results for Pairs should be as follows ... 1 , 2 = 2 Occurances 1 , 3 = 2 Occurances 1 , 4 = 2 Occurances 1 , 5 = 2 Occurances 1 , 6 = 1 Occurances 1 , 7 = 1 Occurances 2 , 3 = 2 Occurances 2 , 4 = 2 Occurances 2 , 5 = 2 Occurances 2 , 6 = 1 Occurances 2 , 7 = 1 Occurances 3 , 4 = 2 Occurances 3 , 5 = 2 Occurances 3 , 6 = 1 Occurances 3 , 7 = 1 Occurances 4 , 5 = 2 Occurances 4 , 6 = 1 Occurances 4 , 7 = 1 Occurances 5 , 6 = 1 Occurances 5 , 7 = 1 Occurances 6 , 7 = 0 Occurances .... NOT as previously stated. Your code Vergel Adriano produced ... V1 V2 Cnt 1 2 2 2 3 2 3 4 2 4 5 2 5 6 1 Thanks in Advance. All the Best. Paul On Aug 14, 4:41 pm, Dave D-C wrote: Paul wrote: Sorry to jump in here.. me too Paul wrote: I have just run your posted code and it is not giving the correct results for either Pairs or Triplets. I put 2 combinations in a sheet in Cells "A1:F2" which were :- 1 2 3 4 5 6 1 2 3 4 5 7 The results for "Pairs" should be ... .. 1 , 9 = 1 Occurances .. How can 1,9 be a pair occurance when there is no 9? ----== Posted via Newsfeeds.Com - Unlimited-Unrestricted-Secure Usenet News==----http://www.newsfeeds.comThe#1Newsgroup Service in the World! 120,000+ Newsgroups ----= East and West-Coast Server Farms - Total Privacy via Encryption =----- Hide quoted text - - Show quoted text -- Hide quoted text - - Show quoted text - |
How to find the most common pair and triplet numbers?
hmmn.. not sure what happened, but I think I see the problem. The line that
you identified is the line where the count is incremented by 1. But somehow the "+" operator got left out. Those lines should be like this: For the pairs: wsResult.Range("D" & lRow2).Value =wsResult.Range("D" & lRow2).Value + 1 For the triplets: wsResult.Range("I" & lRow2).Value = wsResult.Range("I" & lRow2).Value + 1 -- Hope that helps. Vergel Adriano "Paul Black" wrote: Hi Vergel Adriano, It comes up with an ERROR on the line ... wsResult.Range("D" & lRow2).Value =wsResult.Range("D" & lRow2).Value 1 .... for both Pairs & Triplets, but if you remove the 1 at the end it appears to be OK. Your program for combinations ... 1 2 3 4 5 6 1 2 3 4 5 7 .... produces the results ... 1 , 2 = 1 1 , 3 = 1 1 , 4 = 1 1 , 5 = 1 1 , 6 = 1 2 , 3 = 1 2 , 4 = 1 2 , 5 = 1 2 , 6 = 1 3 , 4 = 1 3 , 5 = 1 3 , 6 = 1 4 , 5 = 1 4 , 6 = 1 5 , 6 = 1 1 , 7 = 1 2 , 7 = 1 3 , 7 = 1 4 , 7 = 1 5 , 7 = 1 .... where it should be ... 1 , 2 = 2 1 , 3 = 2 1 , 4 = 2 1 , 5 = 2 1 , 6 = 1 2 , 3 = 2 2 , 4 = 2 2 , 5 = 2 2 , 6 = 1 3 , 4 = 2 3 , 5 = 2 3 , 6 = 1 4 , 5 = 2 4 , 6 = 1 5 , 6 = 1 1 , 7 = 1 2 , 7 = 1 3 , 7 = 1 4 , 7 = 1 5 , 7 = 1 .... because some Pairs are in BOTH combinations. This would obviously be more if there were more than 2 combinations to evaluate. Thanks in Advance. All the Best. Paul On Aug 15, 3:32 pm, Vergel Adriano wrote: Paul, I used the sample data that you gave and the code produced the same result that you identified. So, with this data in A1:F2: 1 2 3 4 5 6 1 2 3 4 5 7 can you tell me for which pair the code is giving a count of 1 but should be 2? -- Hope that helps. Vergel Adriano "Paul Black" wrote: Thanks Vergel Adriano, It is almost there. I ran your code this morning and it does indeed produce only the combinations that are relevant. The only thing is that it is not totally properly. It shows a count of 1 for all the combinations where some should be 2. I think it is calculating the totals purely on the first combination and then going onto the second combination, but there are the same combinations in both so the total should be 2. Thanks again for all your help and time on this, it is very much appreciated. All the Best. Paul On Aug 14, 11:48 pm, Vergel Adriano wrote: I think this is what you're looking for. 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 Dim i As Integer Dim j As Integer 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 For i = 1 To 6 - c.Column strPair = c.Value & "_" & c.Offset(0, i).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, i).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 Next i End If Next c 'Find Triplets lRow = 2 For Each c In rng If c.Column <= 5 Then For i = 1 To 6 - c.Column For j = 1 To 6 - c.Offset(0, i).Column strTriplet = c.Value & "_" & c.Offset(0, i).Value & "_" & c.Offset(0, i + j).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, i).Value wsResult.Range("H" & lRow).Value = c.Offset(0, i + j).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 Next j Next i 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: Well spotted Dave D-C, The actual results for Pairs should be as follows ... 1 , 2 = 2 Occurances 1 , 3 = 2 Occurances 1 , 4 = 2 Occurances 1 , 5 = 2 Occurances 1 , 6 = 1 Occurances 1 , 7 = 1 Occurances 2 , 3 = 2 Occurances 2 , 4 = 2 Occurances 2 , 5 = 2 Occurances 2 , 6 = 1 Occurances 2 , 7 = 1 Occurances 3 , 4 = 2 Occurances 3 , 5 = 2 Occurances 3 , 6 = 1 Occurances 3 , 7 = 1 Occurances 4 , 5 = 2 Occurances 4 , 6 = 1 Occurances 4 , 7 = 1 Occurances 5 , 6 = 1 Occurances 5 , 7 = 1 Occurances 6 , 7 = 0 Occurances .... NOT as previously stated. Your code Vergel Adriano produced ... V1 V2 Cnt 1 2 2 2 3 2 3 4 2 4 5 2 5 6 1 Thanks in Advance. All the Best. Paul On Aug 14, 4:41 pm, Dave D-C wrote: Paul wrote: Sorry to jump in here.. me too Paul wrote: I have just run your posted code and it is not giving the correct results for either Pairs or Triplets. I put 2 combinations in a sheet in Cells "A1:F2" which were :- 1 2 3 4 5 6 1 2 3 4 5 7 The results for "Pairs" should be ... .. 1 , 9 = 1 Occurances .. How can 1,9 be a pair occurance when there is no 9? ----== Posted via Newsfeeds.Com - Unlimited-Unrestricted-Secure Usenet News==----http://www.newsfeeds.comThe#1Newsgroup Service in the World! 120,000+ Newsgroups ----= East and West-Coast Server Farms - Total Privacy via Encryption =----- Hide quoted text - - Show quoted text -- Hide quoted text - - Show quoted text - |
How to find the most common pair and triplet numbers?
Hi Vergel Adriano,
Excellent, it works like a dream. One final point, honestly, how would I get it to calculate singles please. Thanks for ALL your help, time & patience with regard to this, it is appreciated. Thanks in Advance. All the VERY Best. Paul On Aug 15, 4:26 pm, Vergel Adriano wrote: hmmn.. not sure what happened, but I think I see the problem. The line that you identified is the line where the count is incremented by 1. But somehow the "+" operator got left out. Those lines should be like this: For the pairs: wsResult.Range("D" & lRow2).Value =wsResult.Range("D" & lRow2).Value + 1 For the triplets: wsResult.Range("I" & lRow2).Value = wsResult.Range("I" & lRow2).Value + 1 -- Hope that helps. Vergel Adriano "Paul Black" wrote: Hi Vergel Adriano, It comes up with an ERROR on the line ... wsResult.Range("D" & lRow2).Value =wsResult.Range("D" & lRow2).Value 1 .... for both Pairs & Triplets, but if you remove the 1 at the end it appears to be OK. Your program for combinations ... 1 2 3 4 5 6 1 2 3 4 5 7 .... produces the results ... 1 , 2 = 1 1 , 3 = 1 1 , 4 = 1 1 , 5 = 1 1 , 6 = 1 2 , 3 = 1 2 , 4 = 1 2 , 5 = 1 2 , 6 = 1 3 , 4 = 1 3 , 5 = 1 3 , 6 = 1 4 , 5 = 1 4 , 6 = 1 5 , 6 = 1 1 , 7 = 1 2 , 7 = 1 3 , 7 = 1 4 , 7 = 1 5 , 7 = 1 .... where it should be ... 1 , 2 = 2 1 , 3 = 2 1 , 4 = 2 1 , 5 = 2 1 , 6 = 1 2 , 3 = 2 2 , 4 = 2 2 , 5 = 2 2 , 6 = 1 3 , 4 = 2 3 , 5 = 2 3 , 6 = 1 4 , 5 = 2 4 , 6 = 1 5 , 6 = 1 1 , 7 = 1 2 , 7 = 1 3 , 7 = 1 4 , 7 = 1 5 , 7 = 1 .... because some Pairs are in BOTH combinations. This would obviously be more if there were more than 2 combinations to evaluate. Thanks in Advance. All the Best. Paul On Aug 15, 3:32 pm, Vergel Adriano wrote: Paul, I used the sample data that you gave and the code produced the same result that you identified. So, with this data in A1:F2: 1 2 3 4 5 6 1 2 3 4 5 7 can you tell me for which pair the code is giving a count of 1 but should be 2? -- Hope that helps. Vergel Adriano "Paul Black" wrote: Thanks Vergel Adriano, It is almost there. I ran your code this morning and it does indeed produce only the combinations that are relevant. The only thing is that it is not totally properly. It shows a count of 1 for all the combinations where some should be 2. I think it is calculating the totals purely on the first combination and then going onto the second combination, but there are the same combinations in both so the total should be 2. Thanks again for all your help and time on this, it is very much appreciated. All the Best. Paul On Aug 14, 11:48 pm, Vergel Adriano wrote: I think this is what you're looking for. 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 Dim i As Integer Dim j As Integer 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 For i = 1 To 6 - c.Column strPair = c.Value & "_" & c.Offset(0, i).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, i).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 Next i End If Next c 'Find Triplets lRow = 2 For Each c In rng If c.Column <= 5 Then For i = 1 To 6 - c.Column For j = 1 To 6 - c.Offset(0, i).Column strTriplet = c.Value & "_" & c.Offset(0, i).Value & "_" & c.Offset(0, i + j).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, i).Value wsResult.Range("H" & lRow).Value = c.Offset(0, i + j).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 Next j Next i 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: Well spotted Dave D-C, The actual results for Pairs should be as follows ... 1 , 2 = 2 Occurances 1 , 3 = 2 Occurances 1 , 4 = 2 Occurances 1 , 5 = 2 Occurances 1 , 6 = 1 Occurances 1 , 7 = 1 Occurances 2 , 3 = 2 Occurances 2 , 4 = 2 Occurances 2 , 5 = 2 Occurances 2 , 6 = 1 Occurances 2 , 7 = 1 Occurances 3 , 4 = 2 Occurances 3 , 5 = 2 Occurances 3 , 6 = 1 Occurances 3 , 7 = 1 Occurances 4 , 5 = 2 Occurances 4 , 6 = 1 Occurances 4 , 7 = 1 Occurances 5 , 6 = 1 Occurances 5 , 7 = 1 Occurances 6 , 7 = 0 Occurances .... NOT as previously stated. Your code Vergel Adriano produced ... V1 V2 Cnt 1 2 2 2 3 2 3 4 2 4 5 2 5 6 1 Thanks in Advance. All the Best. Paul On Aug 14, 4:41 pm, Dave D-C wrote: Paul wrote: Sorry to jump in here.. me too Paul wrote: I have just run your posted code and it is not giving the correct results for either Pairs or Triplets. I put 2 combinations in a sheet in Cells "A1:F2" which were :- 1 2 3 4 5 6 1 2 3 4 5 7 The results for "Pairs" should be ... .. 1 , 9 = 1 Occurances .. How can 1,9 be a pair occurance when there is no 9? ----== Posted via Newsfeeds.Com - Unlimited-Unrestricted-Secure Usenet News==----http://www.newsfeeds.comThe#1NewsgroupService in the World! 120,000+ Newsgroups ----= East and West-Coast Server Farms - Total Privacy via Encryption =----- Hide quoted text - - Show quoted text -- Hide quoted text - - Show quoted text -- Hide quoted text - - Show quoted text - |
How to find the most common pair and triplet numbers?
Sorry Vergel Adriano,
I tried applying the logic to produce Quadruples but I can't seem to get it to work. Thanks in Advance. All the Best. Paul On Aug 16, 11:09 am, Paul Black wrote: Hi Vergel Adriano, Excellent, it works like a dream. One final point, honestly, how would I get it to calculate singles please. Thanks for ALL your help, time & patience with regard to this, it is appreciated. Thanks in Advance. All the VERY Best. Paul On Aug 15, 4:26 pm, Vergel Adriano wrote: hmmn.. not sure what happened, but I think I see the problem. The line that you identified is the line where the count is incremented by 1. But somehow the "+" operator got left out. Those lines should be like this: For the pairs: wsResult.Range("D" & lRow2).Value =wsResult.Range("D" & lRow2).Value + 1 For the triplets: wsResult.Range("I" & lRow2).Value = wsResult.Range("I" & lRow2).Value + 1 -- Hope that helps. Vergel Adriano "Paul Black" wrote: Hi Vergel Adriano, It comes up with an ERROR on the line ... wsResult.Range("D" & lRow2).Value =wsResult.Range("D" & lRow2).Value 1 .... for both Pairs & Triplets, but if you remove the 1 at the end it appears to be OK. Your program for combinations ... 1 2 3 4 5 6 1 2 3 4 5 7 .... produces the results ... 1 , 2 = 1 1 , 3 = 1 1 , 4 = 1 1 , 5 = 1 1 , 6 = 1 2 , 3 = 1 2 , 4 = 1 2 , 5 = 1 2 , 6 = 1 3 , 4 = 1 3 , 5 = 1 3 , 6 = 1 4 , 5 = 1 4 , 6 = 1 5 , 6 = 1 1 , 7 = 1 2 , 7 = 1 3 , 7 = 1 4 , 7 = 1 5 , 7 = 1 .... where it should be ... 1 , 2 = 2 1 , 3 = 2 1 , 4 = 2 1 , 5 = 2 1 , 6 = 1 2 , 3 = 2 2 , 4 = 2 2 , 5 = 2 2 , 6 = 1 3 , 4 = 2 3 , 5 = 2 3 , 6 = 1 4 , 5 = 2 4 , 6 = 1 5 , 6 = 1 1 , 7 = 1 2 , 7 = 1 3 , 7 = 1 4 , 7 = 1 5 , 7 = 1 .... because some Pairs are in BOTH combinations. This would obviously be more if there were more than 2 combinations to evaluate. Thanks in Advance. All the Best. Paul On Aug 15, 3:32 pm, Vergel Adriano wrote: Paul, I used the sample data that you gave and the code produced the same result that you identified. So, with this data in A1:F2: 1 2 3 4 5 6 1 2 3 4 5 7 can you tell me for which pair the code is giving a count of 1 but should be 2? -- Hope that helps. Vergel Adriano "Paul Black" wrote: Thanks Vergel Adriano, It is almost there. I ran your code this morning and it does indeed produce only the combinations that are relevant. The only thing is that it is not totally properly. It shows a count of 1 for all the combinations where some should be 2. I think it is calculating the totals purely on the first combination and then going onto the second combination, but there are the same combinations in both so the total should be 2. Thanks again for all your help and time on this, it is very much appreciated. All the Best. Paul On Aug 14, 11:48 pm, Vergel Adriano wrote: I think this is what you're looking for. 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 Dim i As Integer Dim j As Integer 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 For i = 1 To 6 - c.Column strPair = c.Value & "_" & c.Offset(0, i).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, i).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 Next i End If Next c 'Find Triplets lRow = 2 For Each c In rng If c.Column <= 5 Then For i = 1 To 6 - c.Column For j = 1 To 6 - c.Offset(0, i).Column strTriplet = c.Value & "_" & c.Offset(0, i).Value & "_" & c.Offset(0, i + j).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, i).Value wsResult.Range("H" & lRow).Value = c.Offset(0, i + j).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 Next j Next i 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: Well spotted Dave D-C, The actual results for Pairs should be as follows ... 1 , 2 = 2 Occurances 1 , 3 = 2 Occurances 1 , 4 = 2 Occurances 1 , 5 = 2 Occurances 1 , 6 = 1 Occurances 1 , 7 = 1 Occurances 2 , 3 = 2 Occurances 2 , 4 = 2 Occurances 2 , 5 = 2 Occurances 2 , 6 = 1 Occurances 2 , 7 = 1 Occurances 3 , 4 = 2 Occurances 3 , 5 = 2 Occurances 3 , 6 = 1 Occurances 3 , 7 = 1 Occurances 4 , 5 = 2 Occurances 4 , 6 = 1 Occurances 4 , 7 = 1 Occurances 5 , 6 = 1 Occurances 5 , 7 = 1 Occurances 6 , 7 = 0 Occurances .... NOT as previously stated. Your code Vergel Adriano produced ... V1 V2 Cnt 1 2 2 2 3 2 3 4 2 4 5 2 5 6 1 Thanks in Advance. All the Best. Paul On Aug 14, 4:41 pm, Dave D-C wrote: Paul wrote: Sorry to jump in here.. me too Paul wrote: I have just run your posted code and it is not giving the correct results for either Pairs or Triplets. I put 2 combinations in a sheet in Cells "A1:F2" which were :- 1 2 3 4 5 6 1 2 3 4 5 7 The results for "Pairs" should be ... .. 1 , 9 = 1 Occurances .. How can 1,9 be a pair occurance when there is no 9? ----== Posted via Newsfeeds.Com - Unlimited-Unrestricted-Secure Usenet News==----http://www.newsfeeds.comThe#1NewsgroupServicein the World! 120,000+ ... read more »- Hide quoted text - - Show quoted text - |
How to find the most common pair and triplet numbers?
Hi Vergel Adriano,
Don't worry about the Quadruples I have worked it out, it is just the singles I can't figure out how to do. The ... If c.Column <= 5 Then < code here End If .... is now obsolete I found out so I have omitted them. Thanks in Advance. All the Best. Paul On Aug 16, 2:16 pm, Paul Black wrote: Sorry Vergel Adriano, I tried applying the logic to produce Quadruples but I can't seem to get it to work. Thanks in Advance. All the Best. Paul On Aug 16, 11:09 am, Paul Black wrote: Hi Vergel Adriano, Excellent, it works like a dream. One final point, honestly, how would I get it to calculate singles please. Thanks for ALL your help, time & patience with regard to this, it is appreciated. Thanks in Advance. All the VERY Best. Paul On Aug 15, 4:26 pm, Vergel Adriano wrote: hmmn.. not sure what happened, but I think I see the problem. The line that you identified is the line where the count is incremented by 1. But somehow the "+" operator got left out. Those lines should be like this: For the pairs: wsResult.Range("D" & lRow2).Value =wsResult.Range("D" & lRow2).Value + 1 For the triplets: wsResult.Range("I" & lRow2).Value = wsResult.Range("I" & lRow2).Value + 1 -- Hope that helps. Vergel Adriano "Paul Black" wrote: Hi Vergel Adriano, It comes up with an ERROR on the line ... wsResult.Range("D" & lRow2).Value =wsResult.Range("D" & lRow2).Value 1 .... for both Pairs & Triplets, but if you remove the 1 at the end it appears to be OK. Your program for combinations ... 1 2 3 4 5 6 1 2 3 4 5 7 .... produces the results ... 1 , 2 = 1 1 , 3 = 1 1 , 4 = 1 1 , 5 = 1 1 , 6 = 1 2 , 3 = 1 2 , 4 = 1 2 , 5 = 1 2 , 6 = 1 3 , 4 = 1 3 , 5 = 1 3 , 6 = 1 4 , 5 = 1 4 , 6 = 1 5 , 6 = 1 1 , 7 = 1 2 , 7 = 1 3 , 7 = 1 4 , 7 = 1 5 , 7 = 1 .... where it should be ... 1 , 2 = 2 1 , 3 = 2 1 , 4 = 2 1 , 5 = 2 1 , 6 = 1 2 , 3 = 2 2 , 4 = 2 2 , 5 = 2 2 , 6 = 1 3 , 4 = 2 3 , 5 = 2 3 , 6 = 1 4 , 5 = 2 4 , 6 = 1 5 , 6 = 1 1 , 7 = 1 2 , 7 = 1 3 , 7 = 1 4 , 7 = 1 5 , 7 = 1 .... because some Pairs are in BOTH combinations. This would obviously be more if there were more than 2 combinations to evaluate. Thanks in Advance. All the Best. Paul On Aug 15, 3:32 pm, Vergel Adriano wrote: Paul, I used the sample data that you gave and the code produced the same result that you identified. So, with this data in A1:F2: 1 2 3 4 5 6 1 2 3 4 5 7 can you tell me for which pair the code is giving a count of 1 but should be 2? -- Hope that helps. Vergel Adriano "Paul Black" wrote: Thanks Vergel Adriano, It is almost there. I ran your code this morning and it does indeed produce only the combinations that are relevant. The only thing is that it is not totally properly. It shows a count of 1 for all the combinations where some should be 2. I think it is calculating the totals purely on the first combination and then going onto the second combination, but there are the same combinations in both so the total should be 2. Thanks again for all your help and time on this, it is very much appreciated. All the Best. Paul On Aug 14, 11:48 pm, Vergel Adriano wrote: I think this is what you're looking for. 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 Dim i As Integer Dim j As Integer 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 For i = 1 To 6 - c.Column strPair = c.Value & "_" & c.Offset(0, i).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, i).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 Next i End If Next c 'Find Triplets lRow = 2 For Each c In rng If c.Column <= 5 Then For i = 1 To 6 - c.Column For j = 1 To 6 - c.Offset(0, i).Column strTriplet = c.Value & "_" & c.Offset(0, i).Value & "_" & c.Offset(0, i + j).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, i).Value wsResult.Range("H" & lRow).Value = c.Offset(0, i + j).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 Next j Next i 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: Well spotted Dave D-C, The actual results for Pairs should be as follows ... 1 , 2 = 2 Occurances 1 , 3 = 2 Occurances 1 , 4 = 2 Occurances 1 , 5 = 2 Occurances 1 , 6 = 1 Occurances 1 , 7 = 1 Occurances 2 , 3 = 2 Occurances 2 , 4 = 2 Occurances 2 , 5 = 2 Occurances 2 , 6 = 1 Occurances 2 , 7 = 1 Occurances 3 , 4 = 2 Occurances 3 , 5 = 2 Occurances 3 , 6 = 1 Occurances 3 , 7 = 1 Occurances 4 , 5 = 2 Occurances 4 , 6 = 1 Occurances 4 , 7 = 1 Occurances 5 , 6 = 1 Occurances 5 , 7 = 1 Occurances 6 , 7 = 0 Occurances .... NOT as previously stated. Your code Vergel Adriano produced ... V1 V2 Cnt 1 2 2 2 3 2 3 4 2 4 5 2 5 6 1 Thanks in Advance. All the Best. Paul On Aug 14, 4:41 pm, Dave D-C wrote: Paul wrote: ... read more »- Hide quoted text - - Show quoted text - |
How to find the most common pair and triplet numbers?
Hi. Here's just an idea if interested.
I would do a search of these newsgroups for programs that do "Subsets" (ie of size 2, 3, etc). There are all kinds of techniques, so pick one you like. I would break the problem down into 4 steps Grab each row of data. Sort that data (so 1,2 and 2,1 are the same) Call Subset Program Dump this data into a totals program. Here's a general idea if interested. In the vba editor, set a Tools | Reference to the library below. One of the many, many terrible things about Excel 2007 is that Microsoft Help system removed Methods and Properties, so It's almost impossible to study new ideas. Therefore, set the library ref to help a little via auto complete. This is just a quick way to count subsets of size 2 combined. Option Explicit Dim Dic As Dictionary ' = = = = = ' Best w/ Ref to "Microsoft Scripting Runtime" ' = = = = = Sub Demo() Dim Dic As New Dictionary Dim M As Variant '(M)atrix Dim r As Long '(R)ow Dim j As Long Dim k As Long Dim Key As String Const Comma As String = "," M = [A1:F2].Value 'or 'M = [A1].CurrentRegion.Value For r = 1 To UBound(M, 1) For j = 1 To 5 For k = j + 1 To 6 Key = Join(Array(M(r, j), M(r, k)), Comma) If Dic.Exists(Key) Then Dic.Item(Key) = Dic.Item(Key) + 1 Else Dic.Add Key, 1 End If Next k, j, r Range("H1:I1").Resize(Dic.Count) = _ WorksheetFunction.Transpose(Array(Dic.Keys, Dic.Items)) ' Sort here if desired End Sub -- HTH :) Dana DeLouis <snip |
How to find the most common pair and triplet numbers?
Hi Vergel Adriano,
Have you had chance to have a look at how I can produce the singles please. This will finish what I am trying to achieve. Thanks in Advance. All the Best. Paul On Aug 16, 2:51 pm, Paul Black wrote: Hi Vergel Adriano, Don't worry about the Quadruples I have worked it out, it is just the singles I can't figure out how to do. The ... If c.Column <= 5 Then < code here End If ... is now obsolete I found out so I have omitted them. Thanks in Advance. All the Best. Paul On Aug 16, 2:16 pm, Paul Black wrote: Sorry Vergel Adriano, I tried applying the logic to produce Quadruples but I can't seem to get it to work. Thanks in Advance. All the Best. Paul On Aug 16, 11:09 am, Paul Black wrote: Hi Vergel Adriano, Excellent, it works like a dream. One final point, honestly, how would I get it to calculate singles please. Thanks for ALL your help, time & patience with regard to this, it is appreciated. Thanks in Advance. All the VERY Best. Paul On Aug 15, 4:26 pm, Vergel Adriano wrote: hmmn.. not sure what happened, but I think I see the problem. The line that you identified is the line where the count is incremented by 1. But somehow the "+" operator got left out. Those lines should be like this: For the pairs: wsResult.Range("D" & lRow2).Value =wsResult.Range("D" & lRow2).Value + 1 For the triplets: wsResult.Range("I" & lRow2).Value = wsResult.Range("I" & lRow2).Value + 1 -- Hope that helps. Vergel Adriano "Paul Black" wrote: Hi Vergel Adriano, It comes up with an ERROR on the line ... wsResult.Range("D" & lRow2).Value =wsResult.Range("D" & lRow2).Value 1 .... for both Pairs & Triplets, but if you remove the 1 at the end it appears to be OK. Your program for combinations ... 1 2 3 4 5 6 1 2 3 4 5 7 .... produces the results ... 1 , 2 = 1 1 , 3 = 1 1 , 4 = 1 1 , 5 = 1 1 , 6 = 1 2 , 3 = 1 2 , 4 = 1 2 , 5 = 1 2 , 6 = 1 3 , 4 = 1 3 , 5 = 1 3 , 6 = 1 4 , 5 = 1 4 , 6 = 1 5 , 6 = 1 1 , 7 = 1 2 , 7 = 1 3 , 7 = 1 4 , 7 = 1 5 , 7 = 1 .... where it should be ... 1 , 2 = 2 1 , 3 = 2 1 , 4 = 2 1 , 5 = 2 1 , 6 = 1 2 , 3 = 2 2 , 4 = 2 2 , 5 = 2 2 , 6 = 1 3 , 4 = 2 3 , 5 = 2 3 , 6 = 1 4 , 5 = 2 4 , 6 = 1 5 , 6 = 1 1 , 7 = 1 2 , 7 = 1 3 , 7 = 1 4 , 7 = 1 5 , 7 = 1 .... because some Pairs are in BOTH combinations. This would obviously be more if there were more than 2 combinations to evaluate. Thanks in Advance. All the Best. Paul On Aug 15, 3:32 pm, Vergel Adriano wrote: Paul, I used the sample data that you gave and the code produced the same result that you identified. So, with this data in A1:F2: 1 2 3 4 5 6 1 2 3 4 5 7 can you tell me for which pair the code is giving a count of 1 but should be 2? -- Hope that helps. Vergel Adriano "Paul Black" wrote: Thanks Vergel Adriano, It is almost there. I ran your code this morning and it does indeed produce only the combinations that are relevant. The only thing is that it is not totally properly. It shows a count of 1 for all the combinations where some should be 2. I think it is calculating the totals purely on the first combination and then going onto the second combination, but there are the same combinations in both so thetotalshould be 2. Thanks again for all your help and time on this, it is very much appreciated. All the Best. Paul On Aug 14, 11:48 pm, Vergel Adriano wrote: I think this is what you're looking for. 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 Dim i As Integer Dim j As Integer 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 For i = 1 To 6 - c.Column strPair = c.Value & "_" & c.Offset(0, i).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, i).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 Next i End If Next c 'Find Triplets lRow = 2 For Each c In rng If c.Column <= 5 Then For i = 1 To 6 - c.Column For j = 1 To 6 - c.Offset(0, i).Column strTriplet = c.Value & "_" & c.Offset(0, i).Value & "_" & c.Offset(0, i + j).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, i).Value wsResult.Range("H" & lRow).Value = c.Offset(0, i + j).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 Next j Next i 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: Well spotted Dave D-C, The actual results for Pairs should be as follows ... 1 , 2 = 2 Occurances 1 , 3 = 2 Occurances 1 , 4 = 2 Occurances 1 , 5 = 2 Occurances 1 , 6 = 1 Occurances 1 , 7 = 1 Occurances 2 , 3 = 2 Occurances 2 , 4 = 2 Occurances 2 , 5 = 2 Occurances 2 , 6 = 1 Occurances 2 , 7 = 1 Occurances 3 , 4 = 2 ... read more »- Hide quoted text - - Show quoted text - |
How to find the most common pair and triplet numbers?
Hi Vergel Adriano,
This is the final thing, honestly. Why wont this code work, it is set up exactly as the Pairs & Triplets are :- Option Explicit Sub Singles() Dim rng As Range Dim wsResult As Worksheet Dim lRow As Long Dim c As Range Dim strSingle As String Dim lRow2 As Long Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.DisplayAlerts = False Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F")) If Not rng Is Nothing Then ' Select and Prepare OR Create "Results" 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 ' "Results" Sheet Setup. With wsResult ' < Singles Setup .Range("A1").Value = "String" .Range("B1").Value = "n1" .Range("C1").Value = "Drawn" End With On Error GoTo 0 ' Find, Calculate and Output ALL Drawn Singles and Statistics. lRow = 2 For Each c In rng strSingle = c.Value On Error Resume Next lRow2 = Application.WorksheetFunction.Match(strSingle, wsResult.Range("A:A"), False) If Err.Number 0 Then wsResult.Range("A" & lRow).Value = strSingle wsResult.Range("B" & lRow).Value = c.Value wsResult.Range("C" & lRow).Value = 1 lRow = lRow + 1 Else wsResult.Range("C" & lRow2).Value = wsResult.Range("C" & lRow2).Value + 1 End If On Error GoTo 0 Next c End If Application.DisplayAlerts = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub Thanks in Advance. All the Best Paul On Aug 20, 4:14 pm, Paul Black wrote: Hi Vergel Adriano, Have you had chance to have a look at how I can produce the singles please. This will finish what I am trying to achieve. Thanks in Advance. All the Best. Paul On Aug 16, 2:51 pm, Paul Black wrote: Hi Vergel Adriano, Don't worry about the Quadruples I have worked it out, it is just the singles I can't figure out how to do. The ... If c.Column <= 5 Then < code here End If ... is now obsolete I found out so I have omitted them. Thanks in Advance. All the Best. Paul On Aug 16, 2:16 pm, Paul Black wrote: Sorry Vergel Adriano, I tried applying the logic to produce Quadruples but I can't seem to get it to work. Thanks in Advance. All the Best. Paul On Aug 16, 11:09 am, Paul Black wrote: Hi Vergel Adriano, Excellent, it works like a dream. One final point, honestly, how would I get it to calculate singles please. Thanks for ALL your help, time & patience with regard to this, it is appreciated. Thanks in Advance. All the VERY Best. Paul On Aug 15, 4:26 pm, Vergel Adriano wrote: hmmn.. not sure what happened, but I think I see the problem. The line that you identified is the line where the count is incremented by 1. But somehow the "+" operator got left out. Those lines should be like this: For the pairs: wsResult.Range("D" & lRow2).Value =wsResult.Range("D" & lRow2).Value + 1 For the triplets: wsResult.Range("I" & lRow2).Value = wsResult.Range("I" & lRow2)..Value + 1 -- Hope that helps. Vergel Adriano "Paul Black" wrote: Hi Vergel Adriano, It comes up with an ERROR on the line ... wsResult.Range("D" & lRow2).Value =wsResult.Range("D" & lRow2).Value 1 .... for both Pairs & Triplets, but if you remove the 1 at the end it appears to be OK. Your program for combinations ... 1 2 3 4 5 6 1 2 3 4 5 7 .... produces the results ... 1 , 2 = 1 1 , 3 = 1 1 , 4 = 1 1 , 5 = 1 1 , 6 = 1 2 , 3 = 1 2 , 4 = 1 2 , 5 = 1 2 , 6 = 1 3 , 4 = 1 3 , 5 = 1 3 , 6 = 1 4 , 5 = 1 4 , 6 = 1 5 , 6 = 1 1 , 7 = 1 2 , 7 = 1 3 , 7 = 1 4 , 7 = 1 5 , 7 = 1 .... where it should be ... 1 , 2 = 2 1 , 3 = 2 1 , 4 = 2 1 , 5 = 2 1 , 6 = 1 2 , 3 = 2 2 , 4 = 2 2 , 5 = 2 2 , 6 = 1 3 , 4 = 2 3 , 5 = 2 3 , 6 = 1 4 , 5 = 2 4 , 6 = 1 5 , 6 = 1 1 , 7 = 1 2 , 7 = 1 3 , 7 = 1 4 , 7 = 1 5 , 7 = 1 .... because some Pairs are in BOTH combinations. This would obviously be more if there were more than 2 combinations to evaluate. Thanks in Advance. All the Best. Paul On Aug 15, 3:32 pm, Vergel Adriano wrote: Paul, I used the sample data that you gave and the code produced the same result that you identified. So, with this data in A1:F2: 1 2 3 4 5 6 1 2 3 4 5 7 can you tell me for which pair the code is giving a count of 1 but should be 2? -- Hope that helps. Vergel Adriano "Paul Black" wrote: Thanks Vergel Adriano, It is almost there. I ran your code this morning and it does indeed produce only the combinations that are relevant. The only thing is that it is not totally properly. It shows a count of 1 for all the combinations where some should be 2. I think it is calculating the totals purely on the first combination and then going onto the second combination, but there are the same combinations in both so thetotalshould be 2. Thanks again for all your help and time on this, it is very much appreciated. All the Best. Paul On Aug 14, 11:48 pm, Vergel Adriano wrote: I think this is what you're looking for. 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 Dim i As Integer Dim j As Integer 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 For i = 1 To 6 - c.Column strPair = c.Value & "_" & c.Offset(0, i).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, i).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 Next i End If Next c 'Find Triplets lRow = 2 For Each c In rng If c.Column <= 5 Then For i = 1 To 6 - c.Column For j = 1 To 6 - c.Offset(0, i).Column strTriplet = c.Value & "_" & c.Offset(0, i).Value & "_" & c.Offset(0, i + j).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, i).Value wsResult.Range("H" & lRow).Value = c.Offset(0, i + j).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 Next j Next i 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 ... read more »- Hide quoted text - - Show quoted text - |
How to find the most common pair and triplet numbers?
Hi Vergel Adriano,
I have tried everything with my limited knowledge to get this to work but to NO avail. Any help will be greatly appreciated. Thanks in Advance. All the Best. Paul On Aug 21, 3:13 pm, Paul Black wrote: Hi Vergel Adriano, This is the final thing, honestly. Why wont this code work, it is set up exactly as the Pairs & Triplets are :- Option Explicit Sub Singles() Dim rng As Range Dim wsResult As Worksheet Dim lRow As Long Dim c As Range Dim strSingle As String Dim lRow2 As Long Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.DisplayAlerts = False Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F")) If Not rng Is Nothing Then ' Select and Prepare OR Create "Results" 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 ' "Results" Sheet Setup. With wsResult ' < Singles Setup .Range("A1").Value = "String" .Range("B1").Value = "n1" .Range("C1").Value = "Drawn" End With On Error GoTo 0 ' Find, Calculate and Output ALL Drawn Singles and Statistics. lRow = 2 For Each c In rng strSingle = c.Value On Error Resume Next lRow2 = Application.WorksheetFunction.Match(strSingle, wsResult.Range("A:A"), False) If Err.Number 0 Then wsResult.Range("A" & lRow).Value = strSingle wsResult.Range("B" & lRow).Value = c.Value wsResult.Range("C" & lRow).Value = 1 lRow = lRow + 1 Else wsResult.Range("C" & lRow2).Value = wsResult.Range("C" & lRow2).Value + 1 End If On Error GoTo 0 Next c End If Application.DisplayAlerts = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub Thanks in Advance. All the Best Paul On Aug 20, 4:14 pm, Paul Black wrote: Hi Vergel Adriano, Have you had chance to have a look at how I can produce the singles please. This will finish what I am trying to achieve. Thanks in Advance. All the Best. Paul On Aug 16, 2:51 pm, Paul Black wrote: Hi Vergel Adriano, Don't worry about the Quadruples I have worked it out, it is just the singles I can't figure out how to do. The ... If c.Column <= 5 Then < code here End If ... is now obsolete I found out so I have omitted them. Thanks in Advance. All the Best. Paul On Aug 16, 2:16 pm, Paul Black wrote: Sorry Vergel Adriano, I tried applying the logic to produce Quadruples but I can't seem to get it to work. Thanks in Advance. All the Best. Paul On Aug 16, 11:09 am, Paul Black wrote: Hi Vergel Adriano, Excellent, it works like a dream. One final point, honestly, how would I get it to calculate singles please. Thanks for ALL your help, time & patience with regard to this, it is appreciated. Thanks in Advance. All the VERY Best. Paul On Aug 15, 4:26 pm, Vergel Adriano wrote: hmmn.. not sure what happened, but I think I see the problem. The line that you identified is the line where the count is incremented by 1. But somehow the "+" operator got left out. Those lines should be like this: For the pairs: wsResult.Range("D" & lRow2).Value =wsResult.Range("D" & lRow2).Value + 1 For the triplets: wsResult.Range("I" & lRow2).Value = wsResult.Range("I" & lRow2).Value + 1 -- Hope that helps. Vergel Adriano "Paul Black" wrote: Hi Vergel Adriano, It comes up with an ERROR on the line ... wsResult.Range("D" & lRow2).Value =wsResult.Range("D" & lRow2).Value 1 .... for both Pairs & Triplets, but if you remove the 1 at the end it appears to be OK. Your program for combinations ... 1 2 3 4 5 6 1 2 3 4 5 7 .... produces the results ... 1 , 2 = 1 1 , 3 = 1 1 , 4 = 1 1 , 5 = 1 1 , 6 = 1 2 , 3 = 1 2 , 4 = 1 2 , 5 = 1 2 , 6 = 1 3 , 4 = 1 3 , 5 = 1 3 , 6 = 1 4 , 5 = 1 4 , 6 = 1 5 , 6 = 1 1 , 7 = 1 2 , 7 = 1 3 , 7 = 1 4 , 7 = 1 5 , 7 = 1 .... where it should be ... 1 , 2 = 2 1 , 3 = 2 1 , 4 = 2 1 , 5 = 2 1 , 6 = 1 2 , 3 = 2 2 , 4 = 2 2 , 5 = 2 2 , 6 = 1 3 , 4 = 2 3 , 5 = 2 3 , 6 = 1 4 , 5 = 2 4 , 6 = 1 5 , 6 = 1 1 , 7 = 1 2 , 7 = 1 3 , 7 = 1 4 , 7 = 1 5 , 7 = 1 .... because some Pairs are in BOTH combinations. This would obviously be more if there were more than 2 combinations to evaluate. Thanks in Advance. All the Best. Paul On Aug 15, 3:32 pm, Vergel Adriano wrote: Paul, I used the sample data that you gave and the code produced the same result that you identified. So, with this data in A1:F2: 1 2 3 4 5 6 1 2 3 4 5 7 can you tell me for which pair the code is giving a count of 1 but should be 2? -- Hope that helps. Vergel Adriano "Paul Black" wrote: Thanks Vergel Adriano, It is almost there. I ran your code this morning and it does indeed produce only the combinations that are relevant. The only thing is that it is not totally properly. It shows a count of 1 for all the combinations where some should be 2. I think it is calculating the totals purely on the first combination and then going onto the second combination, but there are the same combinations in both so thetotalshould be 2. Thanks again for all your help and time on this, it is very much appreciated. All the Best. Paul On Aug 14, 11:48 pm, Vergel Adriano wrote: I think this is what you're looking for. 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 Dim i As Integer Dim j As Integer 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 For i = 1 To 6 - c.Column strPair = c.Value & "_" & c.Offset(0, i).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, i).Value wsResult.Range("D" & lRow).Value = 1 lRow = lRow + 1 Else wsResult.Range("D" & lRow2).Value = ... read more »- Hide quoted text - - Show quoted text - |
How to find the most common pair and triplet numbers?
Hi Vergel Adriano,
Out of interest was do the variables i & j actually do please. 'FindTriplets lRow = 2 For Each c In rng If c.Column <= 5 Then For i = 1 To 6 - c.Column For j = 1 To 6 - c.Offset(0, i).Column strTriplet = c.Value & "_" & c.Offset(0, i).Value & "_" & c.Offset(0, i + j).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, i).Value wsResult.Range("H" & lRow).Value = c.Offset(0, i + j).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 Next j Next i End If Next c End If Thanks in Advance. All the Best. Paul |
| All times are GMT +1. The time now is 10:49 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com