After working on the project for 15 hours of I had my layout set 1 row and 1 column per square, no problem. Then I decided that I needed each square to have multiple rows. I would have never guessed that it would take almost 6 hours to work this out.

The Reason That I Changed the Layout

I had most of the logic worked. When the cell is clicked all the moves for each piece (except casling and en passant). I know which piece could move where and identified any threats to a piece.

At this point I started writing the mechanism that would create and parse chess notations for the moves. Then it hit me. My logic was flawed! Well kinda, there was, however, an better way to load the board into the gaming engine than to read the chess board range. Using the Chess Notation Log to power the Model. This would allow players to import, export and recreate games from their logs.

I already had a Chess Notation Log table but was going to displaying it in a listbox because the row heights were too tall. That is what made me decide to have multiple rows per square.

Previous Layout

New Layout

Adjusting the Ro Heights and Column Widths

This code (based of of Tom Urtis post took most of the time.

Private Sub FitColumnsToRangeHeight(ByRef Target As Range, ByVal RowHeight As Double)
    Const Precision As Double = 0.1
    
    With Target
        .RowHeight = RowHeight
     
        Do While .Width < .Height
            .ColumnWidth = .ColumnWidth + Precision
            DoEvents
        Loop

        Do While .Width > .Height
            .ColumnWidth = .ColumnWidth - Precision
            DoEvents
        Loop
        
    End With
End Sub

Code

Option Explicit
Public Enum PieceType
    King
    Queen
    Rook
    Bishop
    Knight
    Pawn
End Enum

Public Enum PieceColor
    Black = 9818
    White = 9812
End Enum

Public Sub CreateChessBoard()

    Application.ScreenUpdating = False
    Const RowHeight As Double = 15, RowsPerSquare As Long = 4
    Const TopLeftAddress = "B3"
    
    Dim Squares As Range
    
    Rem Reset ActiveWorksheet
    Cells.Delete
    
    With Range(TopLeftAddress).Resize(8 * RowsPerSquare, 9).Offset(0, -1).EntireColumn
        .VerticalAlignment = xlCenter
        .HorizontalAlignment = xlCenter
    End With
    
    Set Squares = Range(TopLeftAddress).Resize(8 * RowsPerSquare, 8)
    
    FitColumnsToRangeHeight Squares, RowHeight
    
    Squares.BorderAround xlSolid, xlMedium
    
    Dim r As Long, c As Long, n As Long
    
    For n = 1 To 8
        r = (n - 1) * RowsPerSquare + 1
        For c = 1 To 8
            With Squares.Cells(r, c).Resize(RowsPerSquare)
                .Merge
                .Interior.Color = IIf((n + c) Mod 2 = 0, xlNone, vbCyan)
                .Name = "_" & Chr(64 + c) & (9 - n)
            End With
        Next
        
        With Squares.Cells(r, 0).Resize(RowsPerSquare)
            .Merge
            .Value = Array(8, 7, 6, 5, 4, 3, 2, 1)(n - 1)
            .Font.Size = 18
        End With
    Next
    
    For c = 1 To 8
        With Squares(Squares.Count + c).Resize(2)
            .Merge
        End With
    Next
    
    With Squares
        .Font.Size = 36
    End With
    
    With Squares.Rows(Squares.Rows.Count + 1)
        .Font.Size = 20
        .Value = Array("A", "B", "C", "D", "E", "F", "G", "H")
    End With
    
    With Squares
        .Rows(1).Value = Array(ChrW(Black + Rook), ChrW(Black + Knight), ChrW(Black + Bishop), ChrW(Black + Queen), ChrW(Black + King), ChrW(Black + Bishop), ChrW(Black + Knight), ChrW(Black + Rook))
        .Rows(RowsPerSquare + 1).Value = Array(ChrW(Black + Pawn), ChrW(Black + Pawn), ChrW(Black + Pawn), ChrW(Black + Pawn), ChrW(Black + Pawn), ChrW(Black + Pawn), ChrW(Black + Pawn), ChrW(Black + Pawn))
        .Rows(RowsPerSquare * 6 + 1).Value = Array(ChrW(White + Pawn), ChrW(White + Pawn), ChrW(White + Pawn), ChrW(White + Pawn), ChrW(White + Pawn), ChrW(White + Pawn), ChrW(White + Pawn), ChrW(White + Pawn))
        .Rows(RowsPerSquare * 7 + 1).Value = Array(ChrW(White + Rook), ChrW(White + Knight), ChrW(White + Bishop), ChrW(White + Queen), ChrW(White + King), ChrW(White + Bishop), ChrW(White + Knight), ChrW(White + Rook))
    End With

End Sub

Private Sub FitColumnsToRangeHeight(ByRef Target As Range, ByVal RowHeight As Double)
    Const Precision As Double = 0.1
    
    With Target
        .RowHeight = RowHeight
     
        Do While .Width < .Height
            .ColumnWidth = .ColumnWidth + Precision
            DoEvents
        Loop

        Do While .Width > .Height
            .ColumnWidth = .ColumnWidth - Precision
            DoEvents
        Loop
        
    End With
End Sub

Why Write a Chess Game

I was inspired to write this after watching a weekly live YouTube stream where the hosts is working out the code, while interacting with the chat. What a phenomenal idea.

I would love to make some training videos but to code a project like this live! Geez, how would I explain scraping 15 hours of work...."This is know as the Waterfall technique....", lol.

Questions

I didn't need this to be pretty, just accurate. So I only have few questions.

• It would be interesting to see another way to write FitColumnsToRangeHeight()
• Color scheme suggestions

I'll have plenty of questions later on. Particularly, when I move on to writing the AI(s). I will probably base them off of Matt's Battle IStrategy. We'll see.