Agregar instrucción a macro ya existente para evitar que se ejecute si cumple una condición

Sub modificar2()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set h2 = Sheets("AGENDA")
    Set h3 = Sheets("REAGENDAR")
    Set h4 = Sheets("INGRESAR_CITA")
    '
    If h3.[D4] = "" Then
        MsgBox "Número de Registro Único está VACIO." & vbCrLf & "" & vbCrLf & "Por favor escriba el RU en el espacio correspondiente.", vbExclamation
        [D4].Select
        Exit Sub
    End If
    '
    Set b = h2.Columns("R").Find(h3.[D4], lookat:=xlWhole)
    If Not b Is Nothing Then
    Sheets("AGENDA").Unprotect Password:="0976342842"
        h2.Cells(b.Row, "B") = h3.[D6]
        h2.Cells(b.Row, "C") = h3.[D7]
        h2.Cells(b.Row, "D") = h3.[D8]
        h2.Cells(b.Row, "E") = h3.[D9]
        h2.Cells(b.Row, "F") = h3.[D10]
        h2.Cells(b.Row, "G") = h3.[D11]
        h2.Cells(b.Row, "H") = h3.[D12]
        h2.Cells(b.Row, "I") = h3.[D13]
        h2.Cells(b.Row, "J") = h3.[D14]
        h2.Cells(b.Row, "K") = h3.[D15]
        h2.Cells(b.Row, "L") = h3.[D16]
        h2.Cells(b.Row, "M") = h3.[D17]
        h2.Cells(b.Row, "N") = h3.[D18]
        h2.Cells(b.Row, "O") = h3.[D19]
        h2.Cells(b.Row, "P") = h3.[D20]
        h2.Cells(b.Row, "Q") = h3.[D21]
        h2.Cells(b.Row, "A") = h3.[D22]
        u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
        With h2.Sort
            .SortFields.Clear
            .SortFields.Add Key:=h2.Range("B2:B" & u), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add Key:=h2.Range("C2:C" & u), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange h2.Range("A1:Q" & u)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    colorearfila1
    Sheets("AGENDA").Protect Password:="0976342842"
    Else
        MsgBox "El número de Registro Único no existe en la AGENDA." & vbCrLf & "" & vbCrLf & "Por favor verifique e Intentelo de nuevo.", vbExclamation
        [D4].Select
    End If
    Sheets("REAGENDAR").Select
    MsgBox "Se ha REAGENDADO la CITA del PACIENTE ... EXITOSAMENTE." & vbCrLf & "" & vbCrLf & "Gracias por Mantener actualizada nuestra AGENDA." & vbCrLf & "" & vbCrLf & "Hasta Pronto.", vbInformation
    h4.Activate
    h4.Range("D22:D24").Select
    Selection.ClearContents
    h3.Activate
    h3.Range("D6:D22").Select
    Selection.ClearContents
    h3.Range("D4").Select
    Selection.ClearContents
    ActiveWorkbook.Save
End Sub

A esa macro quisiera agregarle algo, que verifique que la fecha registrada en la celda "D6" sea superior a la fecha actual (osea a la fecha del dia), si es asi, entonces continúa ejecutando las instrucciones de la macro, pero si la fecha de la celda "D6" es la misma fecha del dia ó anterior, entonces salga un msgbox diciendo "Lamentablemente el sistema solo permite reagendar citas con 24 horas de anticipación a la cita programada. Si necesita registrar una nueva cita para este paciente, favor dirijase a la sección de INGRESAR CITA. Gracias. " con un vbinformation y luego de aceptar ese msgbox que haga lo siguiente para terminar la macro.

    h4.Activate
    h4.Range("D22:D24").Select
    Selection.ClearContents
    h3.Activate
    h3.Range("D6:D22").Select
    Selection.ClearContents
    h3.Range("D4").Select
    Selection. ClearContents
    ActiveWorkbook. Sabe
End Sub