Agregar una instrucción a un evento existente

Este sería un modo:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$D$21" Then 
        ContieneControl
    elseIf Target.Address = "$D$6" Then 
        controlaWeb
    end if
End Sub

Y en un módulo tendrás tu subrutina 'controlaWeb'.

No se si también necesitas ayuda con la subrutina... sino no olvides valorar esta respuesta.

Lo que pasa es que no son intercambiables es decir, necesito que se evaluen ambas celdas tanto la de "D6" como la de "D21", por que son datos diferentes entonces tu al poner el ELSE le estas diciendo o haga una cosa o haga la otra y yo necesito es que haga una cosa Y haga la otra.

Pero solo se puede 'modificar' (de eso se trata el evento Change) una celda por vez.

Si estás modificando la celda D21 se ejecuta algo... si estás modificando la celda D6 ejecutas otra cosa... salvo que quieras que al modificar la celda D21 también controle el contenido (no el cambio) de la celda D6, ¿se trata de esto?

Sdos!

Quizás no te queda claro los alcances del If...ELse... End if, pero esto es lo correcto. Probalo y me comentás luego.

Sdos!

No mira lo que pasa es que en la pregunta yo solicite que me ayudaran con todo el desarrollo, tu solo me estas poniendo una línea de código, eso no me sirve para nada.

Yo lo que necesito es algo como esto pero no se por que en VBA me dice que hay un error.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$D$21" Then ContieneControl
If Target.Address = "$D$21" Then        
Set h = Sheets("WebPage")
        Set b = h.Columns("A").Find(Target, lookat:=xlWhole)
        If Not b Is Nothing Then
            MsgBox "El paciente tiene un 25% de Descuento por inscripción en la Página WEB", vbInformation
            Exit Sub
        End If
        '
        Set h = Sheets("AGENDA")
        Set b = h.Columns("F").Find(Target, lookat:=xlWhole)
        If Not b Is Nothing Then
            MsgBox "La última vez que este paciente nos visitó fue:" & vbCr & vbCr & _
                   h.Cells(b.Row, "B") & " - " & h.Cells(b.Row, "N")& " - " & h.Cells(b.Row, "V")
        End If
    End If
End Sub

También me ofrecí para el resto, por favor lee nuevamente la respuesta enviada.

No se si también necesitas ayuda con la subrutina...

Si la necesitas no hay problemas, te la preparo, solo podías haber dicho que si...

¿Me parece o estás mal predispuesta a recibir mi asistencia?, porque de entrada sin probar me haces una cuestión acerca del Else como si no supiera de qué se trata... por favor puedes mirar mi historial que no llevo 10 años aquí sin saber del tema ;)

http://www.todoexpertos.com/usuarios?mode=Followers 

http://www.todoexpertos.com/usuarios?scope=Total 

Es algo como esto lo que necesito pero no se que es lo que estoy haciendo mal por que algo me dice que esta mal.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$D$21" Then ContieneControl
If Target.Address = "$D$6" Then        
Set h = Sheets("WebPage")
        Set b = h.Columns("A").Find(Target, lookat:=xlWhole)
        If Not b Is Nothing Then
            MsgBox "El paciente tiene un 25% de Descuento por inscripción en la Página WEB", vbInformation
            Exit Sub
        End If
        '
        Set h = Sheets("AGENDA")
        Set b = h.Columns("F").Find(Target, lookat:=xlWhole)
        If Not b Is Nothing Then
            MsgBox "La última vez que este paciente nos visitó fue:" & vbCr & vbCr & _
                   h.Cells(b.Row, "B") & " - " & h.Cells(b.Row, "N")& " - " & h.Cells(b.Row, "V")
        End If
    End If
End Sub

Debe haber un error en la 2da comparación ya que entiendo que debe ser D6, sino comenta:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$21" Then
    ContieneControl
ElseIf Target.Address = "$D$6" Then
    Set h = Sheets("WebPage")
        Set b = h.Columns("A").Find(Target, lookat:=xlWhole)
        If Not b Is Nothing Then
            MsgBox "El paciente tiene un 25% de Descuento por inscripción en la Página WEB", vbInformation
            Exit Sub
        End If
        '
        Set h = Sheets("AGENDA")
        Set b = h.Columns("F").Find(Target, lookat:=xlWhole)
        If Not b Is Nothing Then
            MsgBox "La última vez que este paciente nos visitó fue:" & vbCr & vbCr & _
                   h.Cells(b.Row, "B") & " - " & h.Cells(b.Row, "N") & " - " & h.Cells(b.Row, "V")
        End If
End If
End Sub