View Single Post
  #11   Report Post  
Posted to microsoft.public.excel.programming
Hasan[_2_] Hasan[_2_] is offline
external usenet poster
 
Posts: 32
Default Automatically Check Each Worksheet For Duplicate Entry

On Sep 24, 3:25*am, Hasan wrote:
On Sep 24, 2:42*am, Dave Peterson wrote:





No, it doesn't. *Same as the previous 3 suggestions.


This avoids Sheet3 and the current sheet:


* * * * * * Case Is = LCase(Sh.Name), LCase("Sheet3")
* * * * * * * * 'skip it


Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
* * Dim wsLoop AsWorksheet
* * Dim FoundCell As Range
* * Dim myAddr As String
* * Dim TopRng As Range
* * Dim BotRng As Range
* * Dim BigRng As Range
* * Dim LastRow As Long
* * Dim FirstRow As Long


* * myAddr = "A2:A200"
* * With Sh.Range(myAddr)
* * * * FirstRow = .Row
* * * * LastRow = .Rows(.Rows.Count).Row
* * End With


* * If Intersect(Target, Sh.Range(myAddr)) Is Nothing Then
* * * * Exit Sub
* * End If


* * If Target.Cells.Count 1 Then
* * * * Exit Sub 'single cell at a time
* * End If


* * ForEachwsLoop In ThisWorkbook.Worksheets
* * * * Select Case LCase(wsLoop.Name)
* * * * * * Case Is = LCase("Sheet3")
* * * * * * * * 'skip it
* * * * * * Case Else
* * * * * * * * Set BigRng = wsLoop.Range(myAddr)
* * * * * * * * If LCase(wsLoop.Name) = LCase(Sh.Name) Then
* * * * * * * * * * With BigRng
* * * * * * * * * * * * If Target.Row = FirstRow Then
* * * * * * * * * * * * * * 'in row 2, don't include it
* * * * * * * * * * * * * * Set BigRng = ..Resize(.Rows.Count - 1).Offset(1, 0)
* * * * * * * * * * * * Else
* * * * * * * * * * * * * * If Target.Row = LastRow Then
* * * * * * * * * * * * * * * * 'in row 200, don't include it
* * * * * * * * * * * * * * * * Set BigRng = .Resize(.Rows.Count - 1)
* * * * * * * * * * * * * * Else
* * * * * * * * * * * * * * * * Set TopRng = wsLoop.Range("A" & FirstRow _
* * * * * * * * * * * * * * * * * * * * * * * * & ":A" & Target.Row - 1)
* * * * * * * * * * * * * * * * Set BotRng = wsLoop.Range("A" & Target.Row + 1 _
* * * * * * * * * * * * * * * * * * * * * * * * & ":A" & LastRow)
* * * * * * * * * * * * * * * * Set BigRng = Union(TopRng, BotRng)
* * * * * * * * * * * * * * End If
* * * * * * * * * * * * End If
* * * * * * * * * * End With
* * * * * * * * End If


* * * * * * * * With BigRng
* * * * * * * * * * Set FoundCell = .Cells.Find(what:=Target.Value, _
* * * * * * * * * * * * * * * * * * * * * * * * After:=.Cells(1), _
* * * * * * * * * * * * * * * * * * * * * * * * LookIn:=xlValues, _
* * * * * * * * * * * * * * * * * * * * * * * * LookAt:=xlWhole, _
* * * * * * * * * * * * * * * * * * * * * * * * SearchOrder:=xlByRows, _
* * * * * * * * * * * * * * * * * * * * * * * * SearchDirection:=xlNext, _
* * * * * * * * * * * * * * * * * * * * * * * * MatchCase:=False)
* * * * * * * * End With


* * * * * * * * If FoundCell Is Nothing Then
* * * * * * * * * * 'not found
* * * * * * * * Else
* * * * * * * * * * *MsgBox "Thatentryalready exists he" & vbLf _
* * * * * * * * * * * * & FoundCell.Address(external:=True)
* * * * * * * * * * Application.EnableEvents = False
* * * * * * * * * * Target.ClearContents
* * * * * * * * * * Application.Goto FoundCell, scroll:=True 'or false??
* * * * * * * * * * Application.EnableEvents = True
* * * * * * * * * * Exit For
* * * * * * * * End If
* * * * End Select
* * Next wsLoop


End Sub


Hasan wrote:


<<snipped
The macro is not searching for theduplicateentries in active
worksheet.


--


Dave Peterson


Thanks alot Dave... its working perfect, as i wanted. Thanks again- Hide quoted text -

- Show quoted text -


I'm trying to compare two columns for new entries selected via data
validation list. Sheet3 Column A is the source information and sheet3
column B is the column to compare against. If there are new entries
selected in any sheet of workbook in column A I'd like the macro to
compare the value with the Sheet3 Column A and sheet3 column B. For
example

Sheet3 has following data

Column A ColumnB
123456 Apple
456789 Orange
147894 Pineapple
159357 Orange

My workbook has 4 sheets(Apple, Orange, Pineapple & Sheet 3)

Being in Apple worksheet if the user select 456789 value then the
macro should compare it with sheet3 columnB value, if its orange then
a message box should pop up saying "this Number should go in Orange
worksheet" and same way