```
Sub CreateHoneycomb()
[COLOR=#008080]'variables[/COLOR]
Dim firstCell As Range, Shp As Shape
Dim LeftMost As Double, TopMost As Double, L As Double, T As Double, W As Double
Dim c As Long, r As Long, colCount As Long, rowCount As Long
[COLOR=#008080]'ask user for details[/COLOR]
W = InputBox("width of each hexagon?", "", 30)
colCount = InputBox("how many hexagons across?", "", 10)
rowCount = InputBox("how many hexagons down?", "", 25)
Application.InputBox("Cick on first cell", "Start of comb", "A1", , , , , 8).Activate
[COLOR=#008080]'determine left and top of range[/COLOR]
Set firstCell = ActiveCell
TopMost = firstCell.Top
LeftMost = firstCell.Left
[COLOR=#008080]'create honeycomb[/COLOR]
For c = 0 To colCount - 1
For r = 0 To rowCount - 1
T = TopMost + r * W [COLOR=#008080] 'shape TOP[/COLOR]
If c Mod 2 = 1 Then T = T + W / 2
L = LeftMost + (0.75 * c * W) [COLOR=#008080]'shape LEFT[/COLOR]
Set Shp = ActiveSheet.Shapes.AddShape(msoShapeHexagon, L, T, W, W)
[COLOR=#008000]AmendShapeProperties[/COLOR] Shp
Next r
Next c
firstCell.Activate
End Sub
```