Strikethrough in Excel VBA - excel

Question

When I enter a second date in a cell, I want the initial date to be strikethrough and keep the both date in the same cell
I have a range of cells from column E to H, in which each cell has date.
Your help would be highly appreciated
Sub ColorMeElmo()
'
Dim count As Long
count = ActiveSheet.Cells(Rows.count, "D").End(xlUp).Row
'
Dim i As Long, r1 As Range, r2 As Range
For i = 2 To count
Set r1 = Range("D" & i)
Set r2 = Range("E" & i)
Dim diff1 As Long
diff1 = DateDiff("D", r2.Value, r1.Value)
If diff1 <= 5 Then r2.Interior.Color = vbRed
If diff1 > 5 Then r2.Interior.Color = vbYellow
Next i
For ii = 2 To count
Set r1 = Range("D" & ii)
Set r2 = Range("F" & ii)
Dim diff2 As Long
diff2 = DateDiff("D", r2.Value, r1.Value)
If diff2 <= 5 Then r2.Interior.Color = vbRed
If diff2 > 5 Then r2.Interior.Color = vbYellow
End Sub
Range will change from D, E, F, G, H. But here I give only E

Answer 1

Assuming your dates are already recognized as dates by Excel, you could use the following procedure:
Sub StrikethroughAndNewDate(ByRef rng As Range, ByVal NewDate As Date)
'You can change this value if you need a different date format
Const DateFormat As String = "YYYY-MM-DD"
'Combine dates
rng.Value2 = Format(rng.Value2, DateFormat) & " " & Format(NewDate, DateFormat)
'Add Formatting
rng.Characters(Start:=1, Length:=Len(Format(rng.Value2, DateFormat))).Font.Strikethrough = True
End Sub
Which would give you something like this :
If your dates are both stored as string inside the cells, you could do a simple concatenation instead:
Sub StrikethroughAndNewDate2(ByRef rng As Range, ByVal NewDate As Variant)
'Combine dates
rng.Value2 = rng.Value2 & " " & NewDate
'Add Formatting
rng.Characters(Start:=1, Length:=Len(rng.Value2)).Font.Strikethrough = True
End Sub