In my ongoing quest to demonstrate how VBA code can absolutely be object-oriented, I've started implementing a game of **Battleship** in pure VBA.

This is a rather large project, so I'll split the reviewing across multiple posts. This first one covers the coordinate/grid system.

Each module in the project is annotated with a `@Folder` annotation, which [Rubberduck](http://www.github.com/rubberduck-vba/Rubberduck) uses to organize the modules into a folder hierarchy, making the rather large project easy to navigate despite the poorly tooled IDE; other annotations include:

 - `@IgnoreModule` prevents static code analysis from firing results in that module.
 - `@Description` will eventually translate into `VB_Description` attributes; until then they serve as descriptive comments for public members, where appropriate.


The **GridCoord** class module has a `VB_PredeclaredId = True` module attribute which gives it a *default instance*; I'm only ever using this default instance to invoke the `Create` factory method, which serves as a public parameterized constructor for the class.

The `ToString` method gives a representation in the form of `(x,y)` that can be used internally, and easily round-trips back to a `GridCoord` instance; the `ToA1String` method yields a string representation that can easily be used by the game to display e.g. the selected grid coordinate. That format is just for display, and does not round-trip.

    '@Folder("Battleship.Model")
    '@IgnoreModule UseMeaningfulName; X and Y are perfectly fine names here.
    Option Explicit
    
    Private Type TGridCoord
        X As Long
        Y As Long
    End Type
    
    Private this As TGridCoord
    
    Public Function Create(ByVal xPosition As Long, ByVal yPosition As Long) As GridCoord
        With New GridCoord
            .X = xPosition
            .Y = yPosition
            Set Create = .Self
        End With
    End Function
    
    Public Function FromString(ByVal coord As String) As GridCoord
        coord = Replace(Replace(coord, "(", vbNullString), ")", vbNullString)
        
        Dim coords As Variant
        coords = Split(coord, ",")
        
        Dim xPosition As Long
        xPosition = coords(LBound(coords))
        
        Dim yPosition As Long
        yPosition = coords(UBound(coords))
        
        Set FromString = Create(xPosition, yPosition)
    End Function
    
    Public Property Get X() As Long
        X = this.X
    End Property
    
    Public Property Let X(ByVal value As Long)
        this.X = value
    End Property
    
    Public Property Get Y() As Long
        Y = this.Y
    End Property
    
    Public Property Let Y(ByVal value As Long)
        this.Y = value
    End Property
    
    Public Property Get Self() As GridCoord
        Set Self = Me
    End Property
    
    Public Property Get Default() As GridCoord
        Set Default = New GridCoord
    End Property
    
    Public Function ToString() As String
        ToString = "(" & this.X & "," & this.Y & ")"
    End Function
    
    Public Function ToA1String() As String
        ToA1String = Chr$(64 + this.X) & this.Y
    End Function
    
    Public Function Equals(ByVal other As GridCoord) As Boolean
        Equals = other.X = this.X And other.Y = this.Y
    End Function
    
    Public Function Offset(Optional ByVal xOffset As Long, Optional ByVal yOffset As Long) As GridCoord
        Set Offset = GridCoord.Create(this.X + xOffset, this.Y + yOffset)
    End Function
    
    Public Function IsAdjacent(ByVal other As GridCoord) As Boolean
        If other.Y = this.Y Then
            IsAdjacent = other.X = this.X - 1 Or other.X = this.X + 1
        ElseIf other.X = this.X Then
            IsAdjacent = other.Y = this.Y - 1 Or other.Y = this.Y + 1
        End If
    End Function

The **GridCoordTests** module is a Rubberduck test module that includes 16 passing tests that demonstrate usage and validate the type's behavior.

    '@TestModule
    '@Folder("Tests")
    Option Explicit
    Option Private Module
    
    Private Assert As Rubberduck.AssertClass
    'Private Fakes As Rubberduck.FakesProvider
    
    '@ModuleInitialize
    Public Sub ModuleInitialize()
        Set Assert = CreateObject("Rubberduck.AssertClass")
        'Set Fakes = CreateObject("Rubberduck.FakesProvider")
    End Sub
    
    '@ModuleCleanup
    Public Sub ModuleCleanup()
        Set Assert = Nothing
        'Set Fakes = Nothing
    End Sub
    
    '@TestMethod
    Public Sub CreatesAtSpecifiedXCoordinate()
        Const expectedX As Long = 42
        Const expectedY As Long = 74
        
        Dim sut As GridCoord
        Set sut = GridCoord.Create(expectedX, expectedY)
        
        Assert.AreEqual expectedX, sut.X, "X coordinate mismatched."
        Assert.AreEqual expectedY, sut.Y, "Y coordinate mismatched."
    End Sub
    
    '@TestMethod
    Public Sub DefaultIsZeroAndZero()
        Const expectedX As Long = 0
        Const expectedY As Long = 0
        
        Dim sut As GridCoord
        Set sut = GridCoord.Default
        
        Assert.AreEqual expectedX, sut.X, "X coordinate mismatched."
        Assert.AreEqual expectedY, sut.Y, "Y coordinate mismatched."
    End Sub
    
    '@TestMethod
    Public Sub OffsetAddsX()
        Const xOffset As Long = 1
        Const yOffset As Long = 0
    
        Dim initial As GridCoord
        Set initial = GridCoord.Default
        
        Dim sut As GridCoord
        Set sut = GridCoord.Default
        
        Dim actual As GridCoord
        Set actual = sut.Offset(xOffset, yOffset)
        
        Assert.AreEqual initial.X + xOffset, actual.X
    End Sub
    
    '@TestMethod
    Public Sub OffsetAddsY()
        Const xOffset As Long = 0
        Const yOffset As Long = 1
    
        Dim initial As GridCoord
        Set initial = GridCoord.Default
        
        Dim sut As GridCoord
        Set sut = GridCoord.Default
        
        Dim actual As GridCoord
        Set actual = sut.Offset(xOffset, yOffset)
        
        Assert.AreEqual initial.Y + yOffset, actual.Y
    End Sub
    
    '@TestMethod
    Public Sub FromToString_RoundTrips()
        Dim initial As GridCoord
        Set initial = GridCoord.Default
        
        Dim asString As String
        asString = initial.ToString
        
        Dim sut As GridCoord
        Set sut = GridCoord.FromString(asString)
                
        Assert.AreEqual initial.X, sut.X, "X coordinate mismatched."
        Assert.AreEqual initial.Y, sut.Y, "Y coordinate mismatched."
    End Sub
    
    '@TestMethod
    Public Sub ToStringFormat_NoSpaceCommaSeparatedInParentheses()
        Dim sut As GridCoord
        Set sut = GridCoord.Default
        
        Dim expected As String
        expected = "(" & sut.X & "," & sut.Y & ")"
        
        Dim actual As String
        actual = sut.ToString
        
        Assert.AreEqual expected, actual
    End Sub
    
    '@TestMethod
    Public Sub EqualsReturnsTrueForMatchingCoords()
        Dim other As GridCoord
        Set other = GridCoord.Default
        
        Dim sut As GridCoord
        Set sut = GridCoord.Default
        
        Assert.IsTrue sut.Equals(other)
    End Sub
    
    '@TestMethod
    Public Sub EqualsReturnsFalseForMismatchingCoords()
        Dim other As GridCoord
        Set other = GridCoord.Default.Offset(1)
        
        Dim sut As GridCoord
        Set sut = GridCoord.Default
        
        Assert.IsFalse sut.Equals(other)
    End Sub
    
    '@TestMethod
    Public Sub GivenOneLeftAndSameY_IsAdjacentReturnsTrue()
        Dim other As GridCoord
        Set other = GridCoord.Create(1, 1)
        
        Dim sut As GridCoord
        Set sut = GridCoord.Create(2, 1)
        
        Assert.IsTrue sut.IsAdjacent(other)
    End Sub
    
    '@TestMethod
    Public Sub GivenTwoLeftAndSameY_IsAdjacentReturnsFalse()
        Dim other As GridCoord
        Set other = GridCoord.Create(1, 1)
        
        Dim sut As GridCoord
        Set sut = GridCoord.Create(3, 1)
        
        Assert.IsFalse sut.IsAdjacent(other)
    End Sub
    
    '@TestMethod
    Public Sub GivenOneRightAndSameY_IsAdjacentReturnsTrue()
        Dim other As GridCoord
        Set other = GridCoord.Create(3, 1)
        
        Dim sut As GridCoord
        Set sut = GridCoord.Create(2, 1)
        
        Assert.IsTrue sut.IsAdjacent(other)
    End Sub
    
    '@TestMethod
    Public Sub GivenTwoRightAndSameY_IsAdjacentReturnsFalse()
        Dim other As GridCoord
        Set other = GridCoord.Create(5, 1)
        
        Dim sut As GridCoord
        Set sut = GridCoord.Create(3, 1)
        
        Assert.IsFalse sut.IsAdjacent(other)
    End Sub
    
    '@TestMethod
    Public Sub GivenOneDownAndSameX_IsAdjacentReturnsTrue()
        Dim other As GridCoord
        Set other = GridCoord.Create(1, 2)
        
        Dim sut As GridCoord
        Set sut = GridCoord.Create(1, 1)
        
        Assert.IsTrue sut.IsAdjacent(other)
    End Sub
    
    '@TestMethod
    Public Sub GivenTwoDownAndSameX_IsAdjacentReturnsFalse()
        Dim other As GridCoord
        Set other = GridCoord.Create(1, 3)
        
        Dim sut As GridCoord
        Set sut = GridCoord.Create(1, 1)
        
        Assert.IsFalse sut.IsAdjacent(other)
    End Sub
    
    '@TestMethod
    Public Sub GivenOneUpAndSameX_IsAdjacentReturnsTrue()
        Dim other As GridCoord
        Set other = GridCoord.Create(1, 1)
        
        Dim sut As GridCoord
        Set sut = GridCoord.Create(1, 2)
        
        Assert.IsTrue sut.IsAdjacent(other)
    End Sub
    
    '@TestMethod
    Public Sub GivenTwoUpAndSameX_IsAdjacentReturnsFalse()
        Dim other As GridCoord
        Set other = GridCoord.Create(1, 1)
        
        Dim sut As GridCoord
        Set sut = GridCoord.Create(1, 3)
        
        Assert.IsFalse sut.IsAdjacent(other)
    End Sub

---
    
The **PlayerGrid** class also has a `VB_PredeclaredId = True` module attribute; again, the class' *default instance* is never used to store any state. The `Create` method serves as a public parameterized constructor for the class. The type represents a player's game grid, and encapsulates its state.

    '@Folder("Battleship.Model.Player")
    Option Explicit
    
    Private Const KnownGridStateErrorMsg As String _
        = "Specified coordinate is not in an unknown state."
    Private Const CannotAddShipAtPositionMsg As String _
        = "Cannot add a ship of this size at this position."
    Private Const CannotAddMoreShipsMsg As String _
        = "Cannot add more ships to this grid."
    
    Public Enum PlayerGridErrors
        KnownGridStateError = vbObjectError Or 127
        CannotAddShipAtPosition
        CannotAddMoreShips
    End Enum
    
    Public Enum AttackResult
        Miss
        Hit
        Sunk
    End Enum
    
    Public Enum GridState
        '@Description("Content at this coordinate is unknown.")
        Unknown = -1
        '@Description("Unconfirmed friendly ship position.")
        PreviewShipPosition = 0
        '@Description("Confirmed friendly ship position.")
        ShipPosition = 1
        '@Description("Unconfirmed invalid/overlapping ship position.")
        InvalidPosition = 2
        '@Description("No ship at this coordinate.")
        PreviousMiss = 3
        '@Description("An enemy ship occupies this coordinate.")
        PreviousHit = 4
    End Enum
    
    Private Type TPlayGrid
        Id As Byte
        ships As Collection
        State(1 To Globals.GridSize, 1 To Globals.GridSize) As GridState
    End Type
    
    Private this As TPlayGrid
    
    Public Function Create(ByVal grid As Byte) As PlayerGrid
        With New PlayerGrid
            .GridId = grid
            Set Create = .Self
        End With
    End Function
    
    '@Description("Gets the ID of this grid. 1 for Player1, 2 for Player2.")
    Public Property Get GridId() As Byte
        GridId = this.Id
    End Property
    
    Public Property Let GridId(ByVal value As Byte)
        this.Id = value
    End Property
    
    Public Property Get Self() As PlayerGrid
        Set Self = Me
    End Property
    
    '@Description("Gets the number of ships placed on the grid.")
    Public Property Get ShipCount() As Long
        ShipCount = this.ships.Count
    End Property
    
    Private Sub Class_Initialize()
        Set this.ships = New Collection
        Dim currentX As Long
        For currentX = LBound(this.State, 1) To UBound(this.State, 1)
            Dim currentY As Long
            For currentY = LBound(this.State, 2) To UBound(this.State, 2)
                this.State(currentX, currentY) = GridState.Unknown
            Next
        Next
    End Sub
    
    '@Description("Adds the specified ship to the grid. Throws if position is illegal.")
    Public Sub AddShip(ByVal item As IShip)
        
        If Not CanAddShip(item.GridPosition, item.orientation, item.size) Then
            Err.Raise PlayerGridErrors.CannotAddShipAtPosition, TypeName(Me), CannotAddShipAtPositionMsg
        End If
        
        If this.ships.Count >= Globals.ShipsPerGrid Then
            Err.Raise PlayerGridErrors.CannotAddMoreShips, TypeName(Me), CannotAddMoreShipsMsg
        End If
        
        ' will throw a duplicate key error if item.Name is already in collection
        this.ships.Add item, item.Name
        
        Dim currentX As Long
        For currentX = item.GridPosition.X To item.GridPosition.X + IIf(item.orientation = Horizontal, item.size - 1, 0)
            Dim currentY As Long
            For currentY = item.GridPosition.Y To item.GridPosition.Y + IIf(item.orientation = Vertical, item.size - 1, 0)
                this.State(currentX, currentY) = GridState.ShipPosition
            Next
        Next
    
    End Sub
    
    '@Description("Gets a value indicating whether a ship can be added at the specified position/direction/size.")
    Public Function CanAddShip(ByVal position As GridCoord, ByVal direction As ShipOrientation, ByVal shipSize As Byte) As Boolean
        CanAddShip = (position.X + IIf(direction = Horizontal, shipSize - 1, 0) <= UBound(this.State, 1)) _
                 And (position.Y + IIf(direction = Vertical, shipSize - 1, 0) <= UBound(this.State, 2)) _
                 And (position.X > 0 And position.Y > 0) _
                 And IntersectsAny(position, direction, shipSize) Is Nothing
    End Function
    
    '@Description("Gets a value indicating whether the specified position/direction/size intersects with any existing ship.")
    Public Function IntersectsAny(ByVal position As GridCoord, ByVal direction As ShipOrientation, ByVal shipSize As Byte) As GridCoord
        Dim currentShip As IShip
        For Each currentShip In this.ships
            Dim intersecting As GridCoord
            Set intersecting = currentShip.Intersects(Ship.Create("InsersectCheck", shipSize, direction, position))
            If Not intersecting Is Nothing Then
                Set IntersectsAny = intersecting
                Exit Function
            End If
        Next
    End Function
    
    '@Description("Gets a value indicating whether the specified position/direction/size has any adjacent existing ship.")
    Public Function HasAdjacentShip(ByVal position As GridCoord, ByVal direction As ShipOrientation, ByVal shipSize As Byte) As Boolean
            
        Dim positionX As Long
        Dim positionY As Long
        
        If direction = Horizontal Then
            positionY = position.Y
            For positionX = position.X To position.X + shipSize - 1
                If HasAnyAdjacentShips(GridCoord.Create(positionX, positionY)) Then
                    HasAdjacentShip = True
                    Exit Function
                End If
            Next
        Else
            positionX = position.X
            For positionY = position.Y To position.Y + shipSize - 1
                If HasAnyAdjacentShips(GridCoord.Create(positionX, positionY)) Then
                    HasAdjacentShip = True
                    Exit Function
                End If
            Next
        End If
    End Function
    
    Private Function HasAnyAdjacentShips(ByVal coord As GridCoord) As Boolean
        Dim currentX As Long
        Dim currentY As Long
        Dim currentShip As IShip
        For Each currentShip In this.ships
            If currentShip.orientation = Horizontal Then
                currentY = currentShip.GridPosition.Y
                For currentX = currentShip.GridPosition.X To currentShip.GridPosition.X + currentShip.size - 1
                    If GridCoord.Create(currentX, currentY).IsAdjacent(coord) Then
                        HasAnyAdjacentShips = True
                        Exit Function
                    End If
                Next
            Else
                currentX = currentShip.GridPosition.X
                For currentY = currentShip.GridPosition.Y To currentShip.GridPosition.Y + currentShip.size - 1
                    If GridCoord.Create(currentX, currentY).IsAdjacent(coord) Then
                        HasAnyAdjacentShips = True
                        Exit Function
                    End If
                Next
            End If
        Next
    End Function
    
    '@Description("(side-effecting) Attempts a hit at the specified position; returns the result of the attack, and a reference to the hit ship if successful.")
    Public Function TryHit(ByVal position As GridCoord, Optional ByRef hitShip As IShip) As AttackResult
        
        If this.State(position.X, position.Y) = GridState.PreviousHit Or _
           this.State(position.X, position.Y) = GridState.PreviousMiss Then
            Err.Raise PlayerGridErrors.KnownGridStateError, TypeName(Me), KnownGridStateErrorMsg
        End If
        
        Dim currentShip As IShip
        For Each currentShip In this.ships
            If currentShip.Hit(position) Then
                this.State(position.X, position.Y) = GridState.PreviousHit
                If currentShip.IsSunken Then
                    TryHit = Sunk
                Else
                    TryHit = Hit
                End If
                Set hitShip = currentShip
                Exit Function
            End If
        Next
        
        this.State(position.X, position.Y) = GridState.PreviousMiss
        TryHit = Miss
        
    End Function
    
    '@Description("Gets the GridState value at the specified position.")
    Public Property Get State(ByVal position As GridCoord) As GridState
        On Error Resume Next
        State = this.State(position.X, position.Y)
        On Error GoTo 0
    End Property
    
    '@Description("Gets a 2D array containing the GridState of each coordinate in the grid.")
    Public Property Get StateArray() As Variant
        Dim result(1 To Globals.GridSize, 1 To Globals.GridSize) As Variant
        Dim currentX As Long
        For currentX = 1 To Globals.GridSize
            Dim currentY As Long
            For currentY = 1 To Globals.GridSize
                Dim value As GridState
                value = this.State(currentX, currentY)
                result(currentX, currentY) = IIf(value = Unknown, Empty, value)
            Next
        Next
        StateArray = result
    End Property
    
    '@Description("Gets a value indicating whether the ship at the specified position is sunken.")
    Public Property Get IsSunken(ByVal position As GridCoord) As Boolean
        Dim currentShip As IShip
        For Each currentShip In this.ships
            If currentShip.IsSunken Then
                If currentShip.orientation = Horizontal Then
                    If currentShip.GridPosition.Y = position.Y Then
                        If position.X >= currentShip.GridPosition.X And _
                           position.X <= currentShip.GridPosition.X + currentShip.size - 1 _
                        Then
                            IsSunken = True
                            Exit Property
                        End If
                    End If
                End If
            End If
        Next
    End Property
    
    '@Descrition("Gets a value indicating whether all ships have been sunken.")
    Public Property Get IsAllSunken() As Boolean
        Dim currentShip As IShip
        For Each currentShip In this.ships
            If Not currentShip.IsSunken Then
                IsAllSunken = False
                Exit Property
            End If
        Next
        IsAllSunken = True
    End Property
    
    '@Description("Returns the GridCoord of known hits around the specified hit position.")
    Public Function GetHitArea(ByVal position As GridCoord) As Collection
        Debug.Assert this.State(position.X, position.Y) = GridState.PreviousHit
        
        Dim result As Collection
        Set result = New Collection
        
        Dim currentX As Long
        currentX = position.X
        
        Dim currentY As Long
        currentY = position.Y
        
        If position.X < Globals.GridSize Then
            Do While currentX <= Globals.GridSize And this.State(currentX, currentY) = GridState.PreviousHit
                result.Add GridCoord.Create(currentX, currentY)
                currentX = currentX + 1
            Loop
        ElseIf position.X > 1 Then
            Do While currentX >= 1 And this.State(currentX, currentY) = GridState.PreviousHit
                result.Add GridCoord.Create(currentX, currentY)
                currentX = currentX - 1
            Loop
        End If
        
        currentX = position.X
        currentY = position.Y
        
        If position.Y < Globals.GridSize Then
            Do While currentY <= Globals.GridSize And this.State(currentX, currentY) = GridState.PreviousHit
                result.Add GridCoord.Create(currentX, currentY)
                currentY = currentY + 1
            Loop
        ElseIf position.Y > 1 Then
            Do While currentY >= 1 And this.State(currentX, currentY) = GridState.PreviousHit
                currentY = currentY - 1
            Loop
        End If
        
        Set GetHitArea = result
        
    End Function
    
    '@Description("Removes confirmed ship positions from grid state.")
    Public Sub Scramble()
        Dim currentX As Long
        For currentX = 1 To Globals.GridSize
            Dim currentY As Long
            For currentY = 1 To Globals.GridSize
                If this.State(currentX, currentY) = GridState.ShipPosition Then
                    this.State(currentX, currentY) = GridState.Unknown
                End If
            Next
        Next
    End Sub

The **PlayerGridTests** module is a Rubberduck test module including 19 passing tests that demonstrate usage and validate the type's behavior.

    '@TestModule
    '@Folder("Tests")
    Option Explicit
    Option Private Module
    
    Private Assert As Rubberduck.AssertClass
    'Private Fakes As Rubberduck.FakesProvider
    
    '@ModuleInitialize
    Public Sub ModuleInitialize()
        Set Assert = CreateObject("Rubberduck.AssertClass")
        'Set Fakes = CreateObject("Rubberduck.FakesProvider")
    End Sub
    
    '@ModuleCleanup
    Public Sub ModuleCleanup()
        Set Assert = Nothing
        'Set Fakes = Nothing
    End Sub
    
    '@TestMethod
    Public Sub CanAddShipInsideGridBoundaries_ReturnsTrue()
        Dim position As GridCoord
        Set position = GridCoord.Create(1, 1)
        
        Dim sut As PlayerGrid
        Set sut = New PlayerGrid
        
        Assert.IsTrue sut.CanAddShip(position, Horizontal, Ship.MinimumSize)
    End Sub
    
    '@TestMethod
    Public Sub CanAddShipAtPositionZeroZero_ReturnsFalse()
    'i.e. PlayerGrid coordinates are 1-based
        Dim position As GridCoord
        Set position = GridCoord.Create(0, 0)
        
        Dim sut As PlayerGrid
        Set sut = New PlayerGrid
        
        Assert.IsFalse sut.CanAddShip(position, Horizontal, Ship.MinimumSize)
    End Sub
    
    '@TestMethod
    Public Sub CanAddShipGivenInterectingShips_ReturnsFalse()
        Dim ship1 As IShip
        Set ship1 = Ship.Create("Ship1", 3, Horizontal, GridCoord.Create(1, 1))
        
        Dim ship2 As IShip
        Set ship2 = Ship.Create("Ship2", 3, Vertical, GridCoord.Create(2, 1))
        
        Dim sut As PlayerGrid
        Set sut = New PlayerGrid
        
        sut.AddShip ship1
        Assert.IsFalse sut.CanAddShip(ship2.GridPosition, ship2.orientation, ship2.size)
    End Sub
    
    '@TestMethod
    Public Sub AddingSameShipNameTwice_Throws()
        Const ExpectedError As Long = 457 ' "This key is already associated with an element of this collection"
        On Error GoTo TestFail
        
        Const shipName As String = "TEST"
        
        Dim ship1 As IShip
        Set ship1 = Ship.Create(shipName, 2, Horizontal, GridCoord.Create(1, 1))
        
        Dim ship2 As IShip
        Set ship2 = Ship.Create(shipName, 3, Horizontal, GridCoord.Create(5, 5))
        
        Dim sut As PlayerGrid
        Set sut = New PlayerGrid
        
        sut.AddShip ship1
        sut.AddShip ship2
    
    Assert:
        Assert.Fail "Expected error was not raised."
    
    TestExit:
        Exit Sub
    TestFail:
        If Err.Number = ExpectedError Then
            Resume TestExit
        Else
            Resume Assert
        End If
    End Sub
    
    '@TestMethod
    Public Sub AddingShipOutsideGridBoundaries_Throws()
        Const ExpectedError As Long = PlayerGridErrors.CannotAddShipAtPosition
        On Error GoTo TestFail
        
        Dim ship1 As IShip
        Set ship1 = Ship.Create("TEST", 2, Horizontal, GridCoord.Create(0, 0))
        
        Dim sut As PlayerGrid
        Set sut = New PlayerGrid
        
        sut.AddShip ship1
    
    Assert:
        Assert.Fail "Expected error was not raised."
    
    TestExit:
        Exit Sub
    TestFail:
        If Err.Number = ExpectedError Then
            Resume TestExit
        Else
            Resume Assert
        End If
    End Sub
    
    '@TestMethod
    Public Sub AddingMoreShipsThanGameAllows_Throws()
        Const ExpectedError As Long = PlayerGridErrors.CannotAddMoreShips
        Const MaxValue As Long = Globals.ShipsPerGrid
        On Error GoTo TestFail
        
        Dim sut As PlayerGrid
        Set sut = New PlayerGrid
        
        Dim i As Long
        For i = 1 To Globals.ShipsPerGrid
            sut.AddShip Ship.Create("TEST" & i, 2, Horizontal, GridCoord.Create(1, i))
        Next
        sut.AddShip Ship.Create("TEST" & MaxValue + i, 2, Horizontal, GridCoord.Create(1, MaxValue + 1))
    
    Assert:
        Assert.Fail "Expected error was not raised."
    
    TestExit:
        Exit Sub
    TestFail:
        If Err.Number = ExpectedError Then
            Resume TestExit
        Else
            Resume Assert
        End If
    End Sub
    
    '@TestMethod
    Public Sub TryHitKnownState_Throws()
        Const ExpectedError As Long = PlayerGridErrors.KnownGridStateError
        On Error GoTo TestFail
        
        Dim position As GridCoord
        Set position = GridCoord.Create(1, 1)
        
        Dim sut As PlayerGrid
        Set sut = New PlayerGrid
        sut.AddShip Ship.Create("TEST", 2, Horizontal, position)
        
        sut.TryHit position
        sut.TryHit position
    
    Assert:
        Assert.Fail "Expected error was not raised."
        
    TestExit:
        Exit Sub
    TestFail:
        If Err.Number = ExpectedError Then
            Resume TestExit
        Else
            Resume Assert
        End If
    End Sub
    
    '@TestMethod
    Public Sub TryHitMiss_SetsPreviousMissState()
        Const expected = GridState.PreviousMiss
        
        Dim position As GridCoord
        Set position = GridCoord.Create(1, 1)
        
        Dim badPosition As GridCoord
        Set badPosition = position.Offset(5, 5)
        
        Dim sut As PlayerGrid
        Set sut = New PlayerGrid
        sut.AddShip Ship.Create("TEST", 2, Horizontal, position)
        
        sut.TryHit badPosition
        Dim actual As GridState
        actual = sut.State(badPosition)
        Assert.AreEqual expected, actual
    End Sub
    
    '@TestMethod
    Public Sub TryHitSuccess_SetsPreviousHitState()
        Const expected = GridState.PreviousHit
        
        Dim position As GridCoord
        Set position = GridCoord.Create(1, 1)
        
        Dim sut As PlayerGrid
        Set sut = New PlayerGrid
        sut.AddShip Ship.Create("TEST", 2, Horizontal, position)
        
        sut.TryHit position
        Dim actual As GridState
        actual = sut.State(position)
        Assert.AreEqual expected, actual
    End Sub
    
    '@TestMethod
    Public Sub TryHitSuccess_ReturnsTrue()
        Const expected = GridState.PreviousHit
        
        Dim position As GridCoord
        Set position = GridCoord.Create(1, 1)
        
        Dim sut As PlayerGrid
        Set sut = New PlayerGrid
        sut.AddShip Ship.Create("TEST", 2, Horizontal, position)
        
        Assert.IsTrue sut.TryHit(position)
    End Sub
    
    '@TestMethod
    Public Sub TryHitMisses_ReturnsFalse()
        Const expected = GridState.PreviousMiss
        
        Dim position As GridCoord
        Set position = GridCoord.Create(1, 1)
        
        Dim badPosition As GridCoord
        Set badPosition = position.Offset(5, 5)
        
        Dim sut As PlayerGrid
        Set sut = New PlayerGrid
        sut.AddShip Ship.Create("TEST", 2, Horizontal, position)
        
        Assert.IsFalse sut.TryHit(badPosition)
    End Sub
    
    '@TestMethod
    Public Sub GridInitialState_UnknownState()
        Const expected = GridState.Unknown
        
        Dim sut As PlayerGrid
        Set sut = New PlayerGrid
        
        Dim actual As GridState
        actual = sut.State(GridCoord.Create(1, 1))
        
        Assert.AreEqual expected, actual
    End Sub
    
    '@TestMethod
    Public Sub GivenAdjacentShip_HasRightAdjacentShipReturnsTrue()
        Dim position As GridCoord
        Set position = GridCoord.Create(2, 2)
        
        Dim sut As PlayerGrid
        Set sut = New PlayerGrid
        
        sut.AddShip Ship.Create("TEST", 2, Horizontal, position)
        
        Assert.IsTrue sut.HasAdjacentShip(GridCoord.Create(1, 2), Vertical, 3)
    End Sub
    
    '@TestMethod
    Public Sub GivenAdjacentShip_HasLeftAdjacentShipReturnsTrue()
        Dim position As GridCoord
        Set position = GridCoord.Create(2, 1)
        
        Dim sut As PlayerGrid
        Set sut = New PlayerGrid
        
        sut.AddShip Ship.Create("TEST", 2, Horizontal, position)
        
        Assert.IsTrue sut.HasAdjacentShip(GridCoord.Create(1, 1), Vertical, 3)
    End Sub
    
    '@TestMethod
    Public Sub GivenAdjacentShip_HasDownAdjacentShipReturnsTrue()
        Dim position As GridCoord
        Set position = GridCoord.Create(2, 2)
        
        Dim sut As PlayerGrid
        Set sut = New PlayerGrid
        
        sut.AddShip Ship.Create("TEST", 2, Horizontal, position)
        
        Assert.IsTrue sut.HasAdjacentShip(GridCoord.Create(1, 3), Horizontal, 3)
    End Sub
    
    '@TestMethod
    Public Sub GivenAdjacentShip_HasUpAdjacentShipReturnsTrue()
        Dim position As GridCoord
        Set position = GridCoord.Create(2, 2)
        
        Dim sut As PlayerGrid
        Set sut = New PlayerGrid
        
        sut.AddShip Ship.Create("TEST", 2, Horizontal, position)
        
        Assert.IsTrue sut.HasAdjacentShip(GridCoord.Create(1, 1), Horizontal, 3)
    End Sub
    
    '@TestMethod
    Public Sub GivenAdjacentShipAtHorizontalTipEnd_ReturnsTrue()
        Dim position As GridCoord
        Set position = GridCoord.Create(10, 4)
        
        Dim sut As PlayerGrid
        Set sut = New PlayerGrid
        
        sut.AddShip Ship.Create("TEST", 5, Vertical, position)
        
        Assert.IsTrue sut.HasAdjacentShip(GridCoord.Create(6, 7), Horizontal, 4)
    End Sub
    
    '@TestMethod
    Public Sub GivenAdjacentShipAtVerticalTipEnd_ReturnsTrue()
        Dim position As GridCoord
        Set position = GridCoord.Create(6, 7)
        
        Dim sut As PlayerGrid
        Set sut = New PlayerGrid
        
        sut.AddShip Ship.Create("TEST", 4, Horizontal, position)
        
        Assert.IsTrue sut.HasAdjacentShip(GridCoord.Create(10, 4), Vertical, 5)
    End Sub
    
    '@TestMethod
    Public Sub GivenTwoSideBySideHits_GetHitAreaReturnsTwoItems()
    
        Const expected As Long = 2
    
        Dim sut As PlayerGrid
        Set sut = New PlayerGrid
        
        sut.AddShip Ship.Create("TEST", 5, Horizontal, GridCoord.Create(1, 1))
        sut.TryHit GridCoord.Create(1, 1)
        
        Dim actual As Long
        actual = sut.GetHitArea(GridCoord.Create(1, 1)).Count
    
        Assert.AreEqual expected, actual
    End Sub

---

These two classes are the foundation of the game (I'll upload the whole thing to GitHub once I have everything ready - [here's a teaser video](https://www.dropbox.com/s/cv4yquqzi7ue93y/Battleship-Play.mp4?dl=0)), and since I'm planning to make this project a model of a VBA project to demonstrate Rubberduck's features and debunk any "VBA can't do real OOP" once and for all, I want this to be as good as it gets.

Does *anything* stick out? *Please be picky*!