Count longest 'snake' of contiguous cells?

[dropkickweasel]

Hi,

I posted a similar question a couple of weeks ago, made a little progress (I think), but remain completely stumped as to how to solve my problem.

I have a 21x21 grid of 1s and 0s. (These can be changed if you have a solution that works with blanks/letters/whatever).
The 1s and 0s will be distributed in different cells at different times, though the size of the grid will remain the constant.
I would like to be able to run a macro that will count the longest contiguous run of 1s, allowing for orthogonal changes in direction.
Each cell may only be used once with the exception of a 'crossroads' which may be passed through both vertically and horizontally.

In the image below, I have highlighted in orange the longest run of 1s, which would lead to a count/sum of 52.
In yellow are contiguous runs which are not the longest, or 'offshoots' of the longest run which should not be counted as they are not on the 'path' that I'm trying to trace.

With help from people on this forum I have been using the following code to count cells in each direction, but this doesn't work for the crossroads, or offshoots.
Equally, there is no way to know which order to run the directional codes for the correct solution to any given path.
As a result of this, running the FromLeft and equivalent FromRight code consecutively produces a value twice the length of a single horizontal run of 1s.

Sub FromLeft()

Dim rng As Range
Set rng = Range("Input")

Dim r As Long
Dim c As Long

For r = 1 To 21 Step 1
    For c = 1 To 21 Step 1

'If the cell, or the cell directly left is 0, then leave the cell value as it is
If rng.Cells(r, c).Value = 0 Or rng.Cells(r, c - 1).Value = 0 Then
    rng.Cells(r, c).Value = rng.Cells(r, c).Value
'otherwise, if the cell plus the cell left is > 1, then the cell value becomes the value of the cell left + 1
ElseIf rng.Cells(r, c - 1).Value + rng.Cells(r, c).Value > 1 Then
    rng.Cells(r, c).Value = rng.Cells(r, c - 1).Value + 1
    rng.Cells(r, c - 1).Value = 0
'otherwise, leave the cell value as it was
Else: rng.Cells(r, c).Value = rng.Cells(r, c).Value
End If

    Next c
Next r

End Sub

Any suggestions or advice before I give up on this project?

 

[Fluff]

Duplicate to: Find longest path of 1s through an array of 0s

In future, please do not post the same question multiple times. Per Forum Rules (#12), posts of a duplicate nature will be locked or deleted.

In relation to your question here, I have closed this thread so please continue in the linked thread.