I've changed the macro to test for both X and Y to find the beginning and ending and instead of checking for a "2" in the first column I am checking for a Blank in the 2nd column.

If there are more than 2 samples in a sequence in the source data the macro should still work as expected.

See how this new version works for you.

```
```Dim lRow As Long

Dim rCount As Long

Dim StartSeqX As Double

Dim StartSeqY As Double

Dim StartSeq

Dim EndSeq

Sheets("Result").Activate

Application.ScreenUpdating = False

'Copy the input data to Sheet called "Results"

lRow = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row

Range("A1:H" & lRow).ClearContents

Sheets(1).Range("A1:B" & lRow).Copy

Range("A1").PasteSpecial

'Gets rid of Rows with the Coordinate count which is always "2"

For i = 2 To lRow

If Cells(i, 1) = 2 Then

Range(Cells(i, 1), Cells(i, 2)).Delete

End If

Next

'Gets rid of duplicate coordinates and copies the remainder to Columns D and E

lRow = Range("A" & Rows.Count).End(xlUp).Row

rCount = 2

For i = 2 To lRow

If Cells(i - 1, 1) <> Cells(i, 1) Then

Cells(rCount, 4) = Cells(i, 1)

Cells(rCount, 5) = Cells(i, 2)

rCount = rCount + 1

End If

Next

lRow = Range("D" & Rows.Count).End(xlUp).Row

'Finds sequences of coordinate = beginning = ending for X and Y- and places a blank row between sequences

'The blank row is used to find the count of each sequence and the count is placed in the blanked row

StartSeqX = Cells(2, 4)

StartSeqY = Cells(2, 5)

For i = 4 To lRow * 2

If Cells(i, 4) = StartSeqX And Cells(i, 5) = StartSeqY Then

Range(Cells(i + 1, 4), Cells(i + 1, 5)).Insert

StartSeqX = Cells(i + 2, 4)

StartSeqY = Cells(i + 2, 5)

i = i + 2

End If

Next

'Gets the coordinate count for the first sequence of coordinates

Cells(1, 4) = Application.Count(Range("D2:D" & Range("D2").End(xlDown).Row))

lRow = Range("D" & Rows.Count).End(xlUp).Row

'Gets the coordinate count for the remaining sequence sequences of coordinates

Do Until Range("D1").End(xlDown).Row >= lRow

StartSeq = Range("D1").End(xlDown).Offset(2, 0).Address

EndSeq = Range(StartSeq).End(xlDown).Address

Range(StartSeq).Offset(-1, 0) = Application.Count(Range(StartSeq, EndSeq))

Loop

'Adds Row headers

Range("D1:E1").Insert

Range("D1") = "X"

Range("E1") = "Y"

Range("A1").Activate

Range("A1").Select