Unique record

×

×לי

Hi!

I have a table with 100 records and 10 fields. My problem is how to verify
programmaticaly that when I am adding a new record it must be unique and no
other record in the table has the same combination of values.

Thanks in advance

Eli
 
J

joel

I put the new input data into an array. The array index starts wit
index 0 where I'm comparing th efirst member of the array with column A
2nd item with column B.


Dim NewData(0 to 9)


'add new data here to array


LastRow = Range("A" & rows.count).end(xlup).row

Found = False 'used to determine if new data match an item in th
table
For rowCount = 1 to LastRow
Match = True 'used to determine if any data in the table doesn't
for Colcount = 1 to 10
if NewData(ColCount - 1) <> .cells(RowCount,ColCount) then
Match = False 'data in table doesn't match
Exit For
End if
Next ColCount
'test if the entire row matches new data
if Match = True then
Found = True 'row matches new data, stop testing
Exit For
end if
next Colcount
end if

If Match = True then
msgbox("Data matches a row in the Table")
else
msgbox("Data doesn't match a row in the Table")
end i
 
×

×לי

Thanks Joel for your fast response.

The code you wrote contains two "Next ColCount". Maybe one of them (the last
one) is actually "Next RowCount"?

Eli
 
G

Gary''s Student

This macro assumes that:

1. the data is in columns A thru J
2. data is entered from the bottom
3. once a row is "complete" there will be no blanks in A thru J

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rw As Long, t As Range, r1 As Range
Dim ValueOfRow As String, TestValue As String
Set t = Target
rw = Target.Row
Set r1 = Range("A" & rw & ":J" & rw)

If Intersect(t, r1) Is Nothing Then Exit Sub
If Application.WorksheetFunction.CountBlank(r1) > 0 Then Exit Sub

If rw = 1 Then Exit Sub
ValueOfRow = ""
For i = 1 To 10
ValueOfRow = ValueOfRow & Cells(rw, i).Value
Next

For j = 1 To rw - 1
TestValue = ""
For i = 1 To 10
TestValue = TestValue & Cells(j, i).Value
Next
If TestValue = ValueOfRow Then
MsgBox "row " & rw & " matches row " & j
Exit Sub
End If
Next
MsgBox "row " & rw & " is unique"
End Sub


Because it is worksheet code, it is very easy to install and automatic to use:

1. right-click the tab name near the bottom of the Excel window
2. select View Code - this brings up a VBE window
3. paste the stuff in and close the VBE window

If you have any concerns, first try it on a trial worksheet.

If you save the workbook, the macro will be saved with it.


To remove the macro:

1. bring up the VBE windows as above
2. clear the code out
3. close the VBE window

To learn more about macros in general, see:

http://www.mvps.org/dmcritchie/excel/getstarted.htm

To learn more about Event Macros (worksheet code), see:

http://www.mvps.org/dmcritchie/excel/event.htm
 
J

joel

Yes you are right.

Dim NewData(0 to 9)


'add new data here to array


LastRow = Range("A" & rows.count).end(xlup).row

Found = False 'used to determine if new data match an item in th
table
For rowCount = 1 to LastRow
Match = True 'used to determine if any data in the table doesn't
for Colcount = 1 to 10
if NewData(ColCount - 1) <> .cells(RowCount,ColCount) then
Match = False 'data in table doesn't match
Exit For
End if
Next ColCount
'test if the entire row matches new data
if Match = True then
Found = True 'row matches new data, stop testing
Exit For
end if
next Rowcount
end if

If Match = True then
msgbox("Data matches a row in the Table")
else
msgbox("Data doesn't match a row in the Table")
end i
 
Top