Excel is a wonderful and convenient tool for editing data. But one important functionality is not implemented in it – the control of the uniqueness of the rows. Let's take an example.
Suppose a person wants to rent an apartment. To do this, he opens a website with ads or a booklet with ads, and starts calling everyone in a row, after each call he makes notes about the results of the conversation in Excel. Different ads may have the same phone number, and if a person has already called it, then it is not necessary to call a second time, since all the necessary information about all the ads has already been received.
Or the user enters information about the timesheets of employees. And so it sometimes happens that the user gets a report on the work done for a certain period several times. He or she needs to avoid re-entering.
Or it's just that customer records are kept in Excel, when a new customer arrives, you need to make sure whether he has already come or not yet.
There are quite a lot of options where uniqueness is required when entering into Excel. And here I propose a solution.
Below is the code. If it is not clear how to use it, then it is better to see it once than to read a dry text ten times. Therefore, I have prepared a video on youtube, which you can find by following the link on my profile page.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim originalEntry As Range
Dim rowCount As Long, currentRow As Long, currentCol As Long
Dim key1FormulaTemplate As String, key2FormulaTemplate As String
key1FormulaTemplate = "C[Row]&H[Row]"
key2FormulaTemplate = "D[Row]&I[Row]"
rowCount = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
currentRow = Target.Row
currentCol = Target.Column
If currentCol = 3 Then
Call TryToFindEmployee(Target, rowCount)
End If
If currentCol = 8 Or currentCol = 9 Then
Set originalEntry = CheckForDublicates("A", key1FormulaTemplate, rowCount, currentRow)
If originalEntry Is Nothing Then
Set originalEntry = CheckForDublicates("B", key2FormulaTemplate, rowCount, currentRow)
End If
If Not originalEntry Is Nothing Then
Dim response As Integer
response = MsgBox("Such an entry is already in the list. would you like to see it?", vbYesNo, "Duplicate found")
If response = vbYes Then
originalEntry.Select
End If
End If
End If
End Sub
Sub TryToFindEmployee(changed_cell As Range, rowCount As Long)
Dim currentKey As String
currentKey = changed_cell.Value2
Dim keyRange As Range
Set keyRange = ActiveSheet.Range("C2:C" & rowCount)
Dim foundRange As Range
Set foundRange = keyRange.Find(currentKey, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
Dim response As Integer
If Not (foundRange Is Nothing) Then
If foundRange.Row <> changed_cell.Row Then
Cells(changed_cell.Row, 4).Value = Cells(foundRange.Row, 4).Value
Cells(changed_cell.Row, 5).Value = Cells(foundRange.Row, 5).Value
Cells(changed_cell.Row, 6).Value = Cells(foundRange.Row, 6).Value
End If
End If
End Sub
Function CheckForDublicates(keyColumn As String, keyFormulaTemplate As String, rowCount As Long, currentRow As Long) As Range
Dim keys() As String
keys = Split(keyFormulaTemplate, "&")
Dim keyFormula As String, item As Variant
Dim currentKey As String
For Each item In keys
keyFormula = Replace(item, "[Row]", currentRow)
currentKey = currentKey & Range(keyFormula).Value2
Next item
Dim keyRange As Range
Set keyRange = ActiveSheet.Range(keyColumn & "2:" & keyColumn & rowCount)
Dim foundRange As Range
Set foundRange = keyRange.Find(currentKey, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
Dim response As Integer
If Not (foundRange Is Nothing) Then
If foundRange.Row <> currentRow Then
Set CheckForDublicates = foundRange
Else
Set CheckForDublicates = Nothing
End If
End If
End Function