Macro stops working on row

Please look at the attached sheet. I got some help in this forum earlier (http://www.excelforum.com/excel-prog...-column-c.html) and the code i got worked at first, but when i changed the sheet (added columns) and attempted to alter the code accordingly, now the code stops working at line 222.

I can't tell anything different about the data on lines 223 and so forth that would cause the macro to stop running there, maybe someone with more experience will notice?


Sheet1 is the original data. Sheet2 is after the code has been run. The item descriptions have been removed.

Option Explicit

Sub SortRows()
Dim Rng As Range, Dn As Range, n As Long, ac As Integer
Set Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
ReDim ray(1 To Rng.Count, 1 To 14)
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng

If Dn.Offset(, 9) = "530" Or Dn.Offset(, 9) = "540" Then
If Not .Exists(Dn.Value & Dn.Next.Value & Dn.Offset(, 9)) Then
n = n + 1
.Add Dn.Value & Dn.Next.Value & Dn.Offset(, 9), n
For ac = 1 To 14
If ac = 12 Then
ray(n, ac) = Format(Dn.Offset(, ac - 1), "mm/dd/yyyy")
Else
ray(n, ac) = Dn.Offset(, ac - 1)
End If
Next ac
End If
End If
Next
Sheets("Sheet2").Range("A2").Resize(.Count, 14) = ray
End With

End Sub