Help with Count Please

[Paul Black]

Hi Everyone,

I have a List of Numbers ( First Set ) in Cells B10:G60.
I have Another list of Numbers ( Second Set ) in Cells I10:N20.

What I would like to do is to Count how Many Numbers from the Second Set
of Numbers Appeared in the First Set of Numbers.

For Example, if we take the Second Set of Numbers in Cells I10:N10 and
Count how Many of those Numbers Appeared in the First Set of Numbers in
Cells B10:G10, and then how Many Numbers in Cells I10:N10 Appeared in
B11:G11, and then how Many Numbers in Cells I10:N10 Appeared in B12:G12
etc to the End of Cells B10:G60 and Put the Results in Cells P10:V10.
Then do Exactly the Same Process for Cells I11:N11 and Put the Results
in Cells P11:V11 and so on.

Thanks in Advance.
All the Best.
Paul

 

[Bob Phillips]

P10: =SUMPRODUCT(COUNTIF($B10:$G10,$I10:$N20))
unfortunately you will need to adjust each as you copy across as it is
row/column mix-up, but once done, you can copy down to P11:V11 easily.
--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Paul Black]

Thanks for the Reply Bob,

I Really Wanted to do this Using a Macro as the Two Ranges could Vary
Substantially.
Does it Involve a Complicated Macro.

Thanks in Advance.
All the Best.
Paul



From: Bob Phillips

P10: =SUMPRODUCT(COUNTIF($B10:$G10,$I10:$N20))
unfortunately you will need to adjust each as you copy across as it is
row/column mix-up, but once done, you can copy down to P11:V11 easily.
--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Bob Phillips]

Why is a macro any better just because the ranges vary?

--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Paul Black]

Hi Bob,

What I Meant to Say ( my Fault for Not Explaining it Clearly ) was that
the First Set could Contain 2,000 Sets of Numbers and the Second Set
could Contain 300 Sets of Numbers.
That is why I thought a Macro could Run through and keep a Total of the
Number of Times 0,1,2,3,4,5,6 were Matched and then Put the Results for
EACH Set Next to the Set in Cells P10:V10, P11:V11, P12:V12 etc.
Using Memory Hungry Formulas on this Scale Slows Down the Worksheet to
Almost Standstill.

Thanks Again.
All the Best.
Paul



From: Bob Phillips

Why is a macro any better just because the ranges vary?

--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Tom Ogilvy]

Try this:

Sub BB()
Dim v() As Long
Dim cell As Range, cell1 As Range
For Each cell1 In Range(Cells(10, 9), Cells(Rows.Count, 9).End(xlUp))
Erase v
ReDim v(0 To 6)
For Each cell In Range(Cells(10, 2), Cells(Rows.Count, 2).End(xlUp))
ans = Evaluate("sum(countif(" & cell1.Resize(1, 6).Address & "," & _
cell.Resize(1, 6).Address & "))")
v(ans) = v(ans) + 1
Next
cell1.Offset(0, 7).Resize(1, 7).Value = v
Next
End Sub

 

[Tom Ogilvy]

Note that I assume these are lottery numbers and thus there are no
duplicates in each string of 6 numbers.

 

[Bob Phillips]

Okay Paul, first try

Sub CountRepeats()
Dim rngNums As Range
Dim rngCompare As Range
Dim rngTarget As Range
Dim i As Long
Dim j As Long
Dim k As Long
Dim cell As Range
Dim oRow As Range
Dim cMatches As Long
Dim iLastRow As Long
Dim cCols As Long

On Error GoTo cr_exit
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Set rngNums = Range("B10:G15")
Set rngCompare = Range("I10")
Set rngTarget = Range("P10")

iLastRow = rngCompare.Cells(1, 1).End(xlDown).Row
k = 0
For j = rngCompare.Row To iLastRow
cCols = rngCompare.End(xlToRight).Column - _
rngCompare.Cells(1, 1).Column + 1
i = 1
For Each oRow In rngNums.Rows
cMatches = 0
For Each cell In rngCompare.Resize(1, cCols)
cMatches = cMatches + Application.CountIf(oRow, cell.Value)
Next cell
rngTarget.Offset(k, i - 1).Value = cMatches
i = i + 1
Next oRow
k = k + 1
Set rngCompare = rngCompare.Cells(1, 1).Offset(1, 0)
Next j

cr_exit:
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Paul Black]

That’s Brilliant Thanks Tom,
You are Quite Right, it is for Checking my Lotto Numbers.
One Final Question Please.
I have Inserted a Column ( Column H ) for the Bonus Number.
I have Adjusted the Code so it Starts Outputting in Column Q.
How can the Code be Adjusted so it Accounts for the Bonus Number Please.
Basically so it Outputs 0,1,2,3,4,5,5+,6.
Here is the Adjusted Code :-

Sub BB()
Dim v() As Long
Dim cell As Range
Dim cell1 As Range

Application.ScreenUpdating = False

For Each cell1 In Range(Cells(10, 10), Cells(Rows.Count, 10).End(xlUp))
Erase v
ReDim v(0 To 6)
For Each cell In Range(Cells(10, 2), Cells(Rows.Count, 2).End(xlUp))
ans = Evaluate("sum(countif(" & cell1.Resize(1, 6).Address & "," &
_
cell.Resize(1, 6).Address & "))")
v(ans) = v(ans) + 1
Next
cell1.Offset(0, 7).Resize(1, 7).Value = v
Next

Application.ScreenUpdating = True
End Sub

Thanks VERY Much for your Help on this.
All the Best.
Paul



Re: Help with Count Please
From: Tom Ogilvy

Try this:

Sub BB()
Dim v() As Long
Dim cell As Range, cell1 As Range
For Each cell1 In Range(Cells(10, 9), Cells(Rows.Count, 9).End(xlUp))
Erase v
ReDim v(0 To 6)
For Each cell In Range(Cells(10, 2), Cells(Rows.Count, 2).End(xlUp))
ans = Evaluate("sum(countif(" & cell1.Resize(1, 6).Address & "," & _
cell.Resize(1, 6).Address & "))")
v(ans) = v(ans) + 1
Next
cell1.Offset(0, 7).Resize(1, 7).Value = v
Next
End Sub

 

[Tom Ogilvy]

You'll have to refresh my memory on how the bonus number is used. I am not
familiar with this game.

 

[Paul Black]

Hi Tom,

The Bonus is ONLY Relevant when you Match 5 Numbers.
There is a BIG £££ Difference in Matching 5 Numbers Instead of Matching
5 Numbers AND the Bonus Number.

Thanks Again.
All the Best.
Paul



Re: Help with Count Please
From: Tom Ogilvy

You'll have to refresh my memory on how the bonus number is used. I am
not
familiar with this game.

 

[Tom Ogilvy]

Sub BB()
Dim v() As Long
Dim cell As Range
Dim cell1 As Range
Dim ans As Long
Dim ans1 As Long

Application.ScreenUpdating = False

For Each cell1 In Range(Cells(10, 10), _
Cells(Rows.Count, 10).End(xlUp))
Erase v
ReDim v(0 To 7)
For Each cell In Range(Cells(10, 2), _
Cells(Rows.Count, 2).End(xlUp))
ans = Evaluate("sum(countif(" & cell1.Resize(1, 6).Address _
& "," & cell.Resize(1, 6).Address & "))")
ans1 = Evaluate("countif(" & cell1.Resize(1, 6).Address & _
"," & cell.Offset(0, 6).Address & ")")
If ans = 6 Then
v(7) = v(7) + 1
ElseIf ans = 5 And ans1 = 1 Then
v(6) = v(6) + 1
Else
v(ans) = v(ans) + 1
End If
Next
cell1.Offset(0, 7).Resize(1, 8).Value = v
Next

Application.ScreenUpdating = True
End Sub

 

[Paul Black]

Tom,

Thanks VERY Much for the Code, it Works Perfectly and Produces Exactly
the Results I Desired.

Bob,

Thanks for your Code, Although it is Not Quite what I was After, I will
keep it for Future Use.

Thanks to you Both for your Help, Much Appreciated.

All the Best.
Paul