Code:
Sub kTest()
Dim ka, k(), i As Long, n As Long, c As Long
ka = Range("a1").CurrentRegion.Resize(, 2)
ReDim k(1 To UBound(ka, 1), 1 To 7)
For i = 2 To UBound(ka, 1)
If i = 2 Then
n = n + 1: c = c + 1
k(n, 1) = ka(i, 1): k(n, 2) = ka(i, 1): k(n, 3) = c
k(n, 5) = ka(i, 2): k(n, 6) = ka(i, 2): k(n, 7) = c
Else
If ka(i, 2) - ka(i - 1, 2) = 1 Then
c = c + 1: k(n, 2) = ka(i, 1): k(n, 3) = c
k(n, 6) = ka(i, 2): k(n, 7) = c
Else
n = n + 1: c = 1
k(n, 1) = ka(i, 1): k(n, 2) = ka(i, 1): k(n, 3) = c
k(n, 5) = ka(i, 2): k(n, 6) = ka(i, 2): k(n, 7) = c
End If
End If
Next
If n Then
Range("d1:j1") = Array("Start", "End", "Qty Count", "", "MCP Start", "MCP End", "MCP Count")
Range("d2").Resize(n, 7) = k
End If
End Sub
Bookmarks