Square Cells or Create Graph Cells with VBA

The grid cells in Excel appears to be rectangular by default. In case you would like to convert them into squares as we have graph cells(See image below) then you need to write a macro for that. Column default width is 8.43 points spanning 64 pixels and Row height is 15 points spanning 20 pixels.



The height and width may appear weird to you as Row height is less than Column width but value is almost double.  Let's get clear on this first.


Fact 01: One unit of column width is equal to the width of one character in the Normal style.
Fact 02: For proportional fonts, the width of the character 0 (zero) is used.
Fact 03: If all columns in the range have the same width, the ColumnWidth property returns the width.
Fact 04: If columns in the range have different widths, this property returns Null.

Solution: To achieve our results, we need to proportionate pixels on the basis of points. Simply, we can divide ColumnWidth(pixels) by Width of Columns(points) and multiplying the result with Height of Row(points) and this will be equal to new ColumnWidth(Pixels). Programmatically, we can sum up all of this as follows:

---

Sub Create_Graph_Cells()
'aka Square the Cells or Convert sheet to Grid

'This macro will convert ActiveSheet/Selected Columns to Graph cells 

'based on First Cell dimensions.
    Dim i As Integer
    Dim rng As Range
    If MsgBox("Would you like to Square Cells of Whole Worksheet?", _
              vbYesNo, "Selected Columns or Whole Worksheet?") = vbYes Then
        Set rng = ActiveSheet.Cells
    Else
        Set rng = Selection
    End If
    For i = 1 To 4
        With rng
            .Columns.ColumnWidth = _
            .Columns("A").ColumnWidth / .Columns("A").Width * _
            .Rows(1).Height
        End With
    Next
End Sub

---