Sub MG17Jan41()
Dim Rng As Range, Dn As Range, n As Long, Dic As Object
Dim oMax As Long, oMin As Long, c As Long, Tem As String
c = 1
Set Rng = Range([A2], Cells(Rows.Count, "A").End(xlUp))
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
For Each Dn In Rng: Dic(Mid(Dn.Value, 2, 6) * 1) = 0: Next
oMax = Application.Max(Dic.keys)
oMin = Application.Min(Dic.keys)
Tem = Range("C1").Value: Range("C:C").ClearContents: Range("C1").Value = Tem
For n = oMin To oMax
If Not Dic.exists(n) Then
c = c + 1
Cells(c, "C") = n
End If
Next n
End Sub