ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Check for duplicate numbers from ones entered and anoter set (https://www.excelbanter.com/excel-programming/429114-check-duplicate-numbers-ones-entered-anoter-set.html)

Goldie

Check for duplicate numbers from ones entered and anoter set
 
l need a user to enter a start and finish number, then l need to check that
there are no duplicate numbers from previously entered start and finish
numbers, in another preadsheet.

ie

entered 10,000 to 10,500

Check entries
1 to 1,000
6,000 to 9,000
11,000 to 11,500
10,200 to 10,700

Duplicates found 10,200 to 10,500



Kevin Beckham[_3_]

Check for duplicate numbers from ones entered and anoter set
 
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("CheckEntri es")

'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

"Goldie" wrote:

l need a user to enter a start and finish number, then l need to check that
there are no duplicate numbers from previously entered start and finish
numbers, in another preadsheet.

ie

entered 10,000 to 10,500

Check entries
1 to 1,000
6,000 to 9,000
11,000 to 11,500
10,200 to 10,700

Duplicates found 10,200 to 10,500




All times are GMT +1. The time now is 02:13 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com