Hi Icewynd,
I have been having a lazy afternoon in front of the TV with several cups of coffee.
Thinking about it, if you knew how many times
EACH double had been drawn that might be of an advantage to you.
So bearing that in mind and assuming that the
THREE digits for the combination are in cells
B4 : D4 and continuing down, copy the Macro below into a Module and run it.
IMPORTANT
(1)
CHANGE the Sheet named
Input in the Macro to the name of the Sheet that you have your draw data in.
(2) Insert a sheet named
Results.
Option Explicit
Sub Calculate_Doubles_PAB()
' ***************************************************************************************
' Author - Algorithm written by PAB on the 24-09-2012.
' Objective - Calculate the number of times each double has been drawn.
' ***************************************************************************************
Dim A As Long
Dim B As Long
Dim rng As Range
Dim rw As Range
Dim wsResult As Worksheet
Dim strDouble As String
Dim lRow1 As Long
Dim lRow2 As Long
Dim lastr As Long
With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
End With
Worksheets("Input").Select
lastr = Columns(2).Find(What:="*", LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False, _
SearchFormat:=False).Row
Set rng = ActiveSheet.Range("B4: D" & lastr)
Set wsResult = ActiveWorkbook.Worksheets("Results")
wsResult.UsedRange.Delete
With wsResult
.Range("A2").Value = "String"
.Range("B2").Value = "n1"
.Range("B2").Font.Bold = True
.Range("C2").Value = "n2"
.Range("C2").Font.Bold = True
.Range("D2").Value = "Drawn"
.Range("D2").Font.Bold = True
End With
On Error GoTo 0
lRow1 = 3
For Each rw In rng.Rows
For A = 1 To 2
For B = A + 1 To 3
strDouble = rw.Cells(A).Value & "_" & _
rw.Cells(B).Value
On Error Resume Next
lRow2 = Application.WorksheetFunction.Match(strDouble, wsResult.Range("A:A"), False)
If Err.Number > 0 Then
wsResult.Range("A" & lRow1).Value = strDouble
wsResult.Range("B" & lRow1).Value = rw.Cells(A).Value
wsResult.Range("C" & lRow1).Value = rw.Cells(B).Value
wsResult.Range("D" & lRow1).Value = 1
lRow1 = lRow1 + 1
Else
wsResult.Range("D" & lRow2).Value = wsResult.Range("D" & lRow2).Value + 1
End If
On Error GoTo 0
Next B
Next A
Next rw
Worksheets("Results").Select
With wsResult
.Range("A:A").Clear
Range("B2: D2").End(xlDown).Sort _
Key1:=Range("D2"), Order1:=xlDescending, Header:=xlYes, _
Key2:=Range("B2"), Order2:=xlAscending, Header:=xlYes, _
Key3:=Range("C2"), Order3:=xlAscending, Header:=xlYes
.Columns("B: D").EntireColumn.AutoFit
End With
With Application
.DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
End With
End Sub
Let me know how you get on!
Regards,
PAB
-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-
12:45, restate my assumptions.
Mathematics is the language of nature.
Everything around us can be represented and understood through numbers.
If you graph the numbers of any system, patterns emerge. Therefore, there are patterns everywhere in nature.
Have one on me (that coffee will rot yur innards).