Try this. A bit messy but it works for your example. No idea if it will work for other datasets, the last row part may not work.
Sub x()
Dim r As Long, b1 As Boolean, b2 As Boolean
Application.ScreenUpdating = False
Columns(3).ClearContents
r = 1
Do While Cells(r, 1) <> ""
b1 = Cells(r, 1) > Cells(r, 2)
b2 = Cells(r + 1, 1) > Cells(r + 1, 2)
If b1 <> b2 Then
Do While (Cells(r, 1) > Cells(r, 2)) <> (Cells(r + 1, 1) > Cells(r + 1, 2))
Cells(r, 3) = "No sequence" & Cells(r, 3)
r = r + 1
If Cells(r + 1, 1) = "" Then
Cells(r, 3) = "No sequence"
Exit Sub
End If
Loop
End If
If b1 = b2 And b1 Then
Do While Cells(r, 1) > Cells(r, 2)
Cells(r, 3) = b1 & Cells(r, 3)
r = r + 1
If Cells(r + 1, 1) = "" Then
Cells(r, 3) = "True"
Exit Sub
End If
Loop
End If
If b1 = b2 And Not b1 Then
Do While Cells(r, 1) < Cells(r, 2)
Cells(r, 3) = b1 & Cells(r, 3)
r = r + 1
If Cells(r + 1, 1) = "" Then
Cells(r, 3) = "False"
Exit Sub
End If
Loop
End If
If Cells(r, 1) <> "" Then Cells(r, 3) = Cells(r, 3) & " Transition"
Loop
Application.ScreenUpdating = True
End Sub
EDIT: ok, I know the last row is wrong unless it is no sequence so I will look at that.
EDIT2: have revised code above. Am sure it could be shortened but for the time being try that.
LinkBack URL
About LinkBacks
Register To Reply
Bookmarks