Aggiungere macro verifica doppioni

[systemcrack]

Ciao a tutti,
nel file su cui sto lavorando di cui ho già parlato qui, qui, qui, e qui e chiamato protocollo.xlsm, sono presenti 2 folgi: SCHEDA(foglio1) e REGISTRO(foglio2) che ovviamente "dialogano" tra loro.

In foglio1 nella cella D5 viene inserito un dato che vorrei fosse confrontato con tutti i dati presenti nella colonna A in foglio2 perciò ho provato ad agire così:

Ho tentato di creare una macro che confronta e se trova un doppione apre un MsgBox di avviso, ma non riesco a farla funzionare.. di sicuro sto sbagliando io.. probabilmente tutto.. ricevo un errore di "indice non incluso".

Codice: Seleziona tutto

Sub confronta()
Dim v As Variant, r As Range, rWhere As Range
    v = Sheets("Sheet1").Range("D5").Value
    Set rWhere = Sheets("Sheet2").Range("A:A")
    Set r = rWhere.Find(what:=v, After:=rWhere(1))
    If r Is Nothing Then
         MsgBox "PRATICA GIA PRESENTE"
    End If
End Sub

Poi in Foglio1 ho aggiunto:

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D5")) Is Nothing Then
Call confronta
End If
End Sub

Grazie in anticipo per qualsiasi indicazione e buon weekend a tutti!

[Anthony47]

Se i tuoi fogli si chiamano SCHEDA e REGISTRO e per assurdo nella macro avessi scritto Sheet1 e Sheet2, poco ma sicuro che ricevi un errore di quel tipo.
Comunque potresti provare con questa variante della Sub Worksheet_Change:

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D5")) Is Nothing Then
    If Application.WorksheetFunction.CountIf(Sheets("REGISTRO").Range("A:A"), Range("D5").Value) > 0 Then
        MsgBox ("PRATICA GIA PRESENTE")
    End If
End If
End Sub


(che non necessita della Sub confronta)

[systemcrack]

Se i tuoi fogli si chiamano SCHEDA e REGISTRO e per assurdo nella macro avessi scritto Sheet1 e Sheet2, poco ma sicuro che ricevi un errore di quel tipo.
Comunque potresti provare con questa variante della Sub Worksheet_Change:

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D5")) Is Nothing Then
    If Application.WorksheetFunction.CountIf(Sheets("REGISTRO").Range("A:A"), Range("D5").Value) > 0 Then
        MsgBox ("PRATICA GIA PRESENTE")
    End If
End If
End Sub


(che non necessita della Sub confronta)

Ho provato anche inserendo SCHEDA e REGISTRO , ma non funzionava nemmeno così.
Proverò seguendo il tuo consiglio. Grazie Anthony!

5min dopo
Come sempre funziona egregiamente. Grande Anthony, grazie davvero!