Modifications VBA dans feuille consultations?

[un internaute]

Bonjour le forum,
Voici MACRO dans feuille CONSULTATIONS :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ligne As Long
If Target.Count > 1 Then Exit Sub
If Not Intersect(Range("B3:B" & Rows.Count), Target) Is Nothing Then
Application.EnableEvents = False
If Target <> "" Then
If Not IsError(Application.Match(CSng(Date), Columns("A"), 0)) Then 'Interdire séance le même jour
MsgBox "Une consultation existe déjà à cette date" 'Interdire séance le même jour
Target = ""
End If
End If
Range("A" & Target.Row) = IIf(Target = "", "", Date)
End If
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = True
End Sub


Voici le ThisWorkbook


Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim N As Integer, Couleur As Integer, Indice As Integer
Dim X As String
Dim Tb, TbCoul
Application.ScreenUpdating = False
If Not Intersect(Range("D3190"), Target) Is Nothing Then
Cancel = True
TbCoul = Array(8, 15, 4, 39)
Tb = Array("", "Dr toto", "Dr tata", "Dr titi")
'X = UCase(Trim(Target)) 'Pour mettre en Majuscule
X = (Trim(Target))
If UBound(Filter(Tb, X)) >= 0 Then
Indice = Application.Match(X, Tb, 0) Mod (1 + UBound(Tb))
Target = Tb(Indice)
Couleur = TbCoul(Indice)
If Couleur = 0 Then
Couleur = Target.Offset(0, -1).Interior.ColorIndex
End If
Target.Interior.ColorIndex = Couleur
Else
Target = ""
End If
ElseIf Not Intersect(Range("E3:E190"), Target) Is Nothing Then
Cancel = True
TbCoul = Array(8, 40, 39, 36)
Tb = Array("", "Astralab", "Biolyss", "Chu")
'X = UCase(Trim(Target)) 'Pour mettre en Majuscule
X = (Trim(Target))
If UBound(Filter(Tb, X)) >= 0 Then
Indice = Application.Match(X, Tb, 0) Mod (1 + UBound(Tb))
Target = Tb(Indice)
Couleur = TbCoul(Indice)
If Couleur = 0 Then
Couleur = Target.Offset(0, -1).Interior.ColorIndex
End If
Target.Interior.ColorIndex = Couleur
Else
Target = ""
End If
ElseIf Not Intersect(Range("B3:B190"), Target) Is Nothing Then
Cancel = True
TbCoul = Array(8, 4, 39)
Tb = Array("", "Dr toto", "Dr titi")
'X = UCase(Trim(Target)) 'Pour mettre en Majuscule
X = (Trim(Target))
If UBound(Filter(Tb, X)) >= 0 Then
Indice = Application.Match(X, Tb, 0) Mod (1 + UBound(Tb))
Application.EnableEvents = False
Target = Tb(Indice)
Range("A" & Target.Row) = IIf(Target = "", "", Date)
Application.EnableEvents = True
Couleur = TbCoul(Indice)
If Couleur = 0 Then
Couleur = Target.Offset(0, -1).Interior.ColorIndex
End If
Target.Interior.ColorIndex = Couleur
Else
Target = ""
End If
End If
Application.ScreenUpdating = True
End Sub

Lorsque je double clic viens Dr Toto avec date colonne A.
Si ce n'est pas le bon Dr je double clic une autre fois apparait Dr Titi et ma date en colonne A reste.
Mais si je clic une autre fois la date et le nom du Dr retourne à l'état initial c'est à dire RIEN c'est normal. (ligne code vba en rouge)
Comment pourrais-je lui faire mettre le message "Une consultation existe déjà à cette date" lorsqu'il retrouve le premier Dr (en l'occurence Toto)

Je ne sais pas si mon explication est très compréhensible
Merci d'avance
Bin cordialement