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.

Each module in the project is annotated with a @Folder annotation, which 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.

'@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.

'@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), 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!