This will handle an empty room with varying exit. 999 denotes the exit.
Const mROOM_WALL = 500
Const mROOM_EXIT = 999
Const mMOVE_STRAIGHT = 1
Const mMOVE_DIAG = 1.5
Private Sub m_FindExit(Room As Range, ExitRow As Long, ExitCol As Long)
Dim lngSeatRow As Long
Dim lngSeatCol As Long
For lngSeatRow = 1 To Room.Rows.Count
For lngSeatCol = 1 To Room.Columns.Count
If Room.Cells(lngSeatRow, lngSeatCol) = mROOM_EXIT Then
ExitRow = lngSeatRow
ExitCol = lngSeatCol
Exit Sub
End If
Next
Next
End Sub
Sub Main()
Dim rngRoom As Range
Dim lngSeatRow As Long
Dim lngSeatCol As Long
Dim lngExitRow As Long
Dim lngExitCol As Long
Set rngRoom = Range("B2:N14")
m_FindExit rngRoom, lngExitRow, lngExitCol
For lngSeatRow = 1 To rngRoom.Rows.Count
For lngSeatCol = 1 To rngRoom.Columns.Count
If rngRoom.Cells(lngSeatRow, lngSeatCol) = mROOM_WALL Then
' ignore wall
ElseIf lngSeatRow = lngExitRow And lngSeatCol = lngExitCol Then
' ignore exit
Else
rngRoom.Cells(lngSeatRow, lngSeatCol) = mExitDistance(rngRoom, lngExitRow, lngExitCol, lngSeatRow, lngSeatCol)
End If
Next
Next
End Sub
Private Function mExitDistance(Room As Range, ExitRow As Long, ExitCol As Long, SeatRow As Long, SeatCol As Long) As Double
Dim lngRow As Long
Dim lngCol As Long
Dim lngRowMove As Long
Dim lngColMove As Long
Dim dblCount As Double
lngRow = SeatRow
If lngRow > ExitRow Then
lngRowMove = -1
ElseIf lngRow < ExitRow Then
lngRowMove = 1
Else
lngRowMove = 0
End If
lngCol = SeatCol
If lngCol > ExitCol Then
lngColMove = -1
ElseIf lngCol < ExitCol Then
lngColMove = 1
Else
lngColMove = 0
End If
dblCount = 0
Do While lngRow <> ExitRow Or lngCol <> ExitCol
If lngRowMove = 0 Or lngColMove = 0 Then
dblCount = dblCount + mMOVE_STRAIGHT
Else
dblCount = dblCount + mMOVE_DIAG
End If
lngRow = lngRow + lngRowMove
lngCol = lngCol + lngColMove
If lngRow = ExitRow Then lngRowMove = 0
If lngCol = ExitCol Then lngColMove = 0
Loop
mExitDistance = dblCount
End Function
Bookmarks