Poner bordes a un rango

Hola Bueno Días
Disculpa que te moleste con esta pregunta pero creo que ya tope y no se que hacer.
Mi tengo la siguiente macro que e estado modificando.
Sub bordes()
i = 5
While Range("D" & i).Value <> ""
Set LeftCell = ActiveCell.End(xlToLeft)
Set RightCell = ActiveCell.End(xlToRight)
If Range("D" & i).Value <> Range("D" & i + 1).Value Then
Range("D" & i & ":D" & i).Range(LeftCell, RightCell).Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
i = i + 1
End If
i = i + 1
Wend
End Sub
El problema es que no puedo hacer que me ponga los bordes a toda la line seleccionada.
No se que instrucción dale para que lo haga
Nota:
Si te fijas las lineas puden tener dos datos o hasta 10 siguidos de mismo carácter que comparo así que necesito que me selecciones eso también aunque si no se puede así, podríamos solo seleccionas la columna activa y copiar el formato a las que faltan.
Por favor ayudame
De antemano gracias
Me uuuurge.
Si no me entiendes dime gracias nuevamente