View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Paul Black Paul Black is offline
external usenet poster
 
Posts: 394
Default Use only cells with data in

On Sep 16, 11:03*am, Paul Black wrote:
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