Thanx for the input Malcolm,
But I have this (below) working now, and it's quick, so will leave it at that for now
John
EDIT: PS It also gives the correct results, and, as it is to be used fairly extensively throughout the project, by declaring it as a public function it saves me a lot of typing/copying
Option Explicit
Private Sub CheckIsNew30RoundButton_Click()
Dim Lost, i%, N%, BinaryNum#, BinarySum#
Dim MyArray(1 To 50) As Double, MyValue#
Application.ScreenUpdating = False
For N = 6 To 56 'rows 6 to 56
With Worksheets("DB_30").Rows(N)
Set Lost = .Find(What:="*", LookIn:=xlValues, searchorder:=xlByRows)
If Not Lost Is Nothing Then
BinarySum = 0
For i = 1 To 6
Set Lost = .FindNext(Lost)
BinaryNum = 2 ^ (Lost.Column)
BinarySum = BinarySum + BinaryNum
Next i
MyArray(N - 5) = BinarySum
End If
End With
Next N
Application.ScreenUpdating = True
Range("b65536").End(xlUp).Offset(1, 0).Select
If ActiveCell.Row - 5 <> UniqueItems(MyArray, True) Then
MsgBox "Sorry, your entry for a " & ActiveCell.Offset(-1, 0) & _
" round" & vbLf & _
"duplicates a pre-existing round and will be deleted", , "ERROR ! - You must change your entry."
ActiveCell.EntireRow.Offset(-1, 0).Delete
Else
MsgBox "Congratulations, your " & ActiveCell.Offset(-1, 0) _
& " round is indeed a new round", , "The New Round Has Been Listed..."
End If
End Sub
Function UniqueItems(ArrayIn, Optional Count As Variant) As Variant
' Accepts an array or range as input (This function By JWalk)
' If Count = True or is missing, the function returns the number
' of unique elements
' If Count = False, the function returns a variant array of unique
' elements
Dim Unique() As Variant ' array that holds the unique items
Dim Element As Variant
Dim i As Integer, NumUnique As Integer
Dim FoundMatch As Boolean
' If 2nd argument is missing, assign default value
If IsMissing(Count) Then Count = True
' Counter for number of unique elements
NumUnique = 0
' Loop thru the input array
For Each Element In ArrayIn
FoundMatch = False
' Has item been added yet?
For i = 1 To NumUnique
If Element = Unique(i) Then
FoundMatch = True
GoTo AddItem '(Exit For-Next loop)
End If
Next i
AddItem:
' If not in list, add the item to unique list
If Not FoundMatch Then
NumUnique = NumUnique + 1
ReDim Preserve Unique(NumUnique)
Unique(NumUnique) = Element
End If
Next Element
' Assign a value to the function
If Count Then UniqueItems = NumUnique Else UniqueItems = Unique
End Function