Use only cells with data in

[Paul Black]

Good morning,

I have a program that works great.
It checks several 6 number combinations in columns “N:S” against
another list of 6 number combinations in columns “E:K” to see how many
times they have matched a certain number of times. Both sets of data
can change in size.
However, when I highlight and delete "x" number of cells and re-run
the program it does not recognise the fact that there are less cells
with values in and gives me the wrong answer.
It works if I delete the values at the end of the column but if I
highlight a dozen or so combinations say in the middle and press the
delete button and re-run the code it still counts them as having
numbers in them I think.
Here is the full code ...

Option Explicit
Option Base 1

Sub Multiple_Combination_Checker_PAB()
Dim Start As Double
Start = Timer
Dim Bonus As Long
Dim CombinationDrawn As Range
Dim CombinationToCheck As Range
Dim Matched() As Long
Dim NonBonus As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

Sheets("Macro Program").Select
Range("U8:AB2008").ClearContents

For Each CombinationToCheck In Range(Cells(8, 14), Cells(Rows.Count,
14).End(xlUp))
Erase Matched
ReDim Matched(0 To 7)
For Each CombinationDrawn In Range(Cells(8, 5), Cells(Rows.Count,
5).End(xlUp))
NonBonus = Evaluate("Sum(Countif(" &
CombinationToCheck.Resize(1, 6).Address & _
"," & CombinationDrawn.Resize(1, 6).Address & "))")
Bonus = Evaluate("Countif(" & CombinationToCheck.Resize(1,
6).Address & _
"," & CombinationDrawn.Offset(0, 6).Address & ")")
If NonBonus = 6 Then
Matched(7) = Matched(7) + 1
ElseIf NonBonus = 5 And Bonus = 1 Then
Matched(6) = Matched(6) + 1
Else
Matched(NonBonus) = Matched(NonBonus) + 1
End If
Next
CombinationToCheck.Offset(0, 7).Resize(1, 8).Value = Matched
Next

Range("A1").Value = Format(((Timer - Start) / 24 / 60 / 60),
"hh:mm:ss")

Range("AE16").Select
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

I have tried to adapt the code using DCOUNT & COUNTA etc but without
any success.
Has anyone got any ideas please?
Thanks in advance.

Kind regards,
Paul

 

[Paul Black]

Good morning,

I have a program that works great.
It checks several 6 number combinations in columns “N:S” against
another list of 6 number combinations in columns “E:K” to see how many
times they have matched a certain number of times. Both sets of data
can change in size.
However, when I highlight and delete "x" number of cells and re-run
the program it does not recognise the fact that there are less cells
with values in and gives me the wrong answer.
It works if I delete the values at the end of the column but if I
highlight a dozen or so combinations say in the middle and press the
delete button and re-run the code it still counts them as having
numbers in them I think.
Here is the full code ...

Option Explicit
Option Base 1

Sub Multiple_Combination_Checker_PAB()
Dim Start As Double
Start = Timer
Dim Bonus As Long
Dim CombinationDrawn As Range
Dim CombinationToCheck As Range
Dim Matched() As Long
Dim NonBonus As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

Sheets("Macro Program").Select
Range("U8:AB2008").ClearContents

For Each CombinationToCheck In Range(Cells(8, 14), Cells(Rows.Count,
14).End(xlUp))
    Erase Matched
    ReDim Matched(0 To 7)
    For Each CombinationDrawn In Range(Cells(8, 5), Cells(Rows.Count,
5).End(xlUp))
        NonBonus = Evaluate("Sum(Countif(" &
CombinationToCheck.Resize(1, 6).Address & _
            "," & CombinationDrawn.Resize(1, 6).Address & "))")
        Bonus = Evaluate("Countif(" & CombinationToCheck.Resize(1,
6).Address & _
            "," & CombinationDrawn.Offset(0, 6).Address & ")")
        If NonBonus = 6 Then
            Matched(7) = Matched(7) + 1
        ElseIf NonBonus = 5 And Bonus = 1 Then
            Matched(6) = Matched(6) + 1
        Else
            Matched(NonBonus) = Matched(NonBonus) + 1
        End If
    Next
    CombinationToCheck.Offset(0, 7).Resize(1, 8).Value = Matched
Next

Range("A1").Value = Format(((Timer - Start) / 24 / 60 / 60),
"hh:mm:ss")

Range("AE16").Select
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

I have tried to adapt the code using DCOUNT & COUNTA etc but without
any success.
Has anyone got any ideas please?
Thanks in advance.

Kind regards,
Paul

Has anyone got any ideas please.
I have searched the Internet but can't seem to find a solution for
this.

Kind regards,
Paul

 

[GS]

Is there some reason you aren't using arrays to do the comparisons? It
would certainly be much faster than reading the wks for each
CombinationDraw, AND not subject to any worksheet function anomolies!

Also, why do you make the 'Option Base 1' statement to only Dim Matched
with a zero base? IMO, declaring 'Option Base 1' is never a good idea
in most cases!<g>

 

[Paul Black]

Is there some reason you aren't using arrays to do the comparisons? It
would certainly be much faster than reading the wks for each
CombinationDraw, AND not subject to any worksheet function anomolies!

Also, why do you make the 'Option Base 1' statement to only Dim Matched
with a zero base? IMO, declaring 'Option Base 1' is never a good idea
in most cases!<g>

--
Garry

Free usenet access athttp://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Thanks for the reply Garry.
In fact the code was put together by someone else as I have limited
VBA knowledge.
I have tried to adapt the code but unfortunately have not been able
to.
Is there a simple solution to this?

Kind regards,
Paul

 

[GS]

Paul Black brought next idea :

Thanks for the reply Garry.
In fact the code was put together by someone else as I have limited
VBA knowledge.
I have tried to adapt the code but unfortunately have not been able
to.
Is there a simple solution to this?

Kind regards,
Paul

Paul,
There could be a simple solution if it's absolutely clear what it is
that you want to accomplish. Your explanation suggests you want to take
a row of 7 individual numbers (6+bonus) drawn in range1 and compare
them to each combination of a 6 number set of 'wheeled' numbers in
range2.

Since there's already tonnes of freeware out there to do this, I have
to assume this is a school project as it doesn't make sense to spend
the time to figure out how to duplicate what's already been done.
However, if you persist toward a VB solution then try searching for
code samples that find matches using arrays, by looping 1 array (inner
loop) against another array (outer loop).

Example: (air code)

vNumsDrawn = Range("DrawnNums"): vNumsWheeled = Range("WheeledNums")
For n = LBound(vNumsDrawn) To UBound(vNumsDrawn)
For i = LBound(vNumsWheeled) To UBound(vNumsWheeled)
If vNumsDrawn(n, 1) = Empty Then
Exit For '//check another value
Else
If vNumsWheeled(i, 1) = vNumsDrawn(n, 1) Then
iMatches = iMatches + 1
'other processing...

 

[Paul Black]

Paul Black brought next idea :








Paul,
There could be a simple solution if it's absolutely clear what it is
that you want to accomplish. Your explanation suggests you want to take
a row of 7 individual numbers (6+bonus) drawn in range1 and compare
them to each combination of a 6 number set of 'wheeled' numbers in
range2.

Since there's already tonnes of freeware out there to do this, I have
to assume this is a school project as it doesn't make sense to spend
the time to figure out how to duplicate what's already been done.
However, if you persist toward a VB solution then try searching for
code samples that find matches using arrays, by looping 1 array (inner
loop) against another array (outer loop).

Example: (air code)

  vNumsDrawn = Range("DrawnNums"): vNumsWheeled = Range("WheeledNums")
  For n = LBound(vNumsDrawn) To UBound(vNumsDrawn)
    For i = LBound(vNumsWheeled) To UBound(vNumsWheeled)
      If vNumsDrawn(n, 1) = Empty Then
        Exit For '//check another value
      Else
        If vNumsWheeled(i, 1) = vNumsDrawn(n, 1) Then
          iMatches = iMatches + 1
          'other processing...

--
Garry

Free usenet access athttp://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Hi Garry,

Unfortunately I left school in 1979, many moons ago.
The code does work if there are no gaps in the data in Range1.
I have a spreadsheet with all the data in and just wanted to run the
code from a button within the designated sheet.
Thanks for your help and advice, I will google your suggestions.

Kind regards,
Paul

 

[Paul Black]

Hi Garry,

Unfortunately I left school in 1979, many moons ago.
The code does work if there are no gaps in the data in Range1.
I have a spreadsheet with all the data in and just wanted to run the
code from a button within the designated sheet.
Thanks for your help and advice, I will google your suggestions.

Kind regards,
Paul

Hi Garry,

I am using Excel 2007.
I searched code samples that find matches using arrays, by looping 1
array (inner loop) against another array (outer loop).
Unfortunately I could not adapt my findings into a working code,
probably because of by limited understanding of VBA.
Anyway, I have tried to put in extra criteria using SUMPRODUCT instaed
of COUNTIF to only count if the cell or combination is greater than
blank but without any success.
The SUMPRODUCT still returns a count on the blank data.

Kind regards,
Paul

 

[GS]

Paul,
My code will work for your scenario if adapted to suit your data
layout. The best way to example this for you is if you send me your
xlsx...

gesansomATnetscapeDOTnet

Be sure to clearly indicate where you want the results to appear.