Modificar macro para que me muestre las vigencias de los productos y así mismo los productos vencidos

Quisiera modificar mi macro para que me muestre los productos vencidos y las vigencias de los productos restantes les dejo la macro que utilizo saludos

Private Sub Workbook_Open()
'POR JAIRO ESCALANTE
'Declaración de variables
Dim MiRango As Range
Dim Celda As Range
Dim Nombre, Nombre2, Mensaje
Dim Nombree, Nombreee, Mensajee
Dim Nombree1, Nombreee1, Mensajee1
'
Set MiRango = Range("H5:I46")
'
'Recorremos cada celda y validamos VS la fecha actual
'
For Each Celda In MiRango
      If WorksheetFunction.Text(Celda.Value, "dd-mm") _
       = WorksheetFunction.Text(Date, "dd-mm") Then
        Mensaje = "LOS SIGUIENTES PRODUCTOS VENCEN EL DIA DE HOY: " & Date
        Nombre = Celda.Offset(0, 2).Value
        Nombre2 = Nombre2 & vbNewLine & Nombre
        End If
       If WorksheetFunction.Text(Celda.Value, "dd-mm") _
       > WorksheetFunction.Text(Date, "dd-mm") Then
        Mensajee1 = "ESTOS PRODUCTOS ESTAN A TIEMPO: " & Date
        Nombree1 = Celda.Offset(0, 2).Value
        Nombreee1 = Nombreee1 & vbNewLine & Nombree1
      End If
Next Celda
'
'Mostramos mensajes
'
If IsEmpty(Nombre2) Then
    MsgBox "No hay Productos que Venzan Hoy.", vbInformation, "AVISO DE VENCIMIENTO"
Else
    MsgBox Mensaje & Nombre2, vbInformation, ""
End If
If IsEmpty(Nombreee1) Then
    MsgBox "No hay Productos A Vencer. ", vbInformation, "AVISO DE VENCIMIENTO"
Else
    MsgBox Mensajee1 & Nombreee1, vbInformation, ""
End If
End Sub