This code will check, return True if no overlap else False with a message
It will not work for fractions or numbers outside valid row designations of
a worksheet
It assumes that the existing values are side by side somewhere below a named
range. If the sheet with the existing values is not active then the named
range will need to be specified more explicitly - uncomment the line and
replace the sheet name in the quotes
Kevin
Function bCheck_Entries(ByVal iStart As Long, ByVal iFinish As Long) As
Boolean
'assume user has entered Start and Finish values via some mechanism
'assume that there is a named range somewhere called CheckEntries _
below which are pairs of numbers that are previous start and finish bounds
Dim rngCheckEntries As Range
Dim rngEntriesToCheck As Range
Dim rngNewEntries As Range
Dim rngDuplicates As Range
Dim iRow As Long
Dim sMsg As String
'order for safety
If iStart > iFinish Then
iRow = iStart
iStart = iFinish
iFinish = iRow
End If
'only good for 1 to 1048576 values (Excel 2007) or 65356 (Excel 97)
If iFinish > ActiveSheet.Rows.Count Then
'alert user
MsgBox "Value(s) too large", vbExclamation + vbOKOnly, "Check
entries failed"
bCheck_Entries = False
Exit Function
ElseIf iStart < 1 Then
'alert user
MsgBox "Value(s) too small", vbExclamation + vbOKOnly, "Check
entries failed"
bCheck_Entries = False
Exit Function
End If
'point to the list of existing entries
'may require sheet reference if not on active sheet
Set rngCheckEntries = Range("CheckEntries")
'Set rngCheckEntries =
ThisWorkbook.Worksheet("Sheet1").Range("CheckEntries")
'make sure there is something to do
If IsEmpty(rngCheckEntries.Offset(1, 0)) Then
bCheck_Entries = True
Exit Function
End If
'build a pseudo-range using existing entries
With rngCheckEntries
'initialise vars
Set rngEntriesToCheck = Range("A" & .Offset(1, 0).Value & ":A" &
..Offset(1, 1).Value)
iRow = 2
Do While Not IsEmpty(.Offset(iRow, 0))
Set rngEntriesToCheck = Application.Union(rngEntriesToCheck,
Range("A" & .Offset(iRow, 0).Value & ":A" & .Offset(iRow, 1).Value))
iRow = iRow + 1
Loop
End With
'make pseudo range of entries to be checked
Set rngNewEntries = Range("A" & iStart & ":A" & iFinish)
'see if there are duplicates
Set rngDuplicates = Application.Intersect(rngEntriesToCheck,
rngNewEntries)
If rngDuplicates Is Nothing Then
bCheck_Entries = True
Else
'tell user what the duplicates are
sMsg = "Duplicates exist"
For iRow = 1 To rngDuplicates.Areas.Count
With rngDuplicates.Areas(iRow)
sMsg = sMsg & vbLf & " from " & .Row & " to " & .Row +
..Rows.Count - 1
End With
Next iRow
'alert user
MsgBox sMsg, vbExclamation + vbOKOnly, "Duplicate entries found"
bCheck_Entries = False
End If
End Function 'bCheck_Entries
