Code will not do whole file

[Dazzawm]

I have been given this code that I am sure a lot of you can read and understand what it does. The problem is whatever the file size I use it on it only completes about 3/4s of it. If the file has 10 rows it only does about 7 of it or if it has 1000 rows it only completes about 700. Any ideas on why this could be? Thanks.

Sub Dazzawm()
Application.ScreenUpdating = False
Dim Rng     As Range
Dim Dn      As Range
Dim Twn     As String
Dim Q
Dim K
Dim ac      As Long
Dim c       As Long
Dim tot     As Long
    Set Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
    With CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
        For Each Dn In Rng
            Twn = Dn & Dn(, 2) & Dn(, 3)
                If Not .Exists(Twn) Then
                    .Add Twn, Array(Dn, Dn(, 2), Dn(, 3), Dn(, 4), Dn(, 5), Dn(, 6), Dn(, 7))
                Else
                    Q = .Item(Twn)
                        Q(3) = Application.Min(Q(3), Dn(, 4))
                        Q(4) = Application.Max(Q(4), Dn(, 5))
                    .Item(Twn) = Q
                End If
Next
For Each K In .Keys
    tot = tot + (.Item(K)(4) - .Item(K)(3))
Next K
ReDim ray(1 To tot + .Count, 1 To 7)
    For Each K In .Keys
      For ac = .Item(K)(3) To .Item(K)(4)
            c = c + 1
            ray(c, 1) = .Item(K)(0)
            ray(c, 2) = .Item(K)(1)
            ray(c, 3) = .Item(K)(2)
            ray(c, 4) = ac
            ray(c, 5) = .Item(K)(5)
            ray(c, 6) = .Item(K)(6)
        Next ac
    Next K
Range("H2").Resize(tot, 6) = ray
End With
Range("A1:D1").Select
    Selection.Copy
    Range("H1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("F1:G1").Select
    Selection.Copy
    Range("L1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("A:G").Select
    Selection.Delete Shift:=xlToLeft
    Cells.Select
    Cells.EntireColumn.AutoFit
    Columns("C:C").Select
    Selection.NumberFormat = "0.0"
    Range("A1").Select
    Application.ScreenUpdating = True
End Sub

 

[baitmaster]

difficult to read exactly what is going on here, but in my experience, where code appears to work, but misses some of the worksheet, AND you are performing a delete somewhere in your code, it's for the following reason

you are working top to bottom, then at some point deleting a section. As you delete this, each section below shifts up. You then move on to the next row, missing one out where it shifted up into your "previous" row. This also happens working left to right and deleting columns

this is just a hunch...