#3917 Excel Macro for Designing Home Floor Plans
#3917 Excel Macro for Designing Home Floor Plans
#3917 I have a 3-column table in Excel: Room, Length and Width with 20 or more rows. Provide a macro to generate a text object of length=Length/10 and width=Width/10 with the room name and dimensions as a centered pair of labels. The text objects are to be drag-n-dropped by the user within the worksheet to "arrange the rooms".
Here is a VBA macro to accomplish this.
The Setup
This macro assumes:
Your data starts in Column A (Room Name), Column B (Length), and Column C (Width).
Row 1 is the Header.
The data starts in Row 2.
The Logic (Important Note on Scaling)
Excel defines shape dimensions in Points (1/72 of an inch).
If your room is 12 units long, the formula
12 / 10equals 1.2.A shape 1.2 points wide is invisible (microscopic).
To fix this, the code below treats the result of your formula (Value/10) as centimeters. This ensures the shapes are large enough to be seen and manipulated while maintaining the correct aspect ratio.
The Macro
Sub GenerateRoomObjects()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim shp As Shape
Dim roomName As String
Dim roomLen As Double, roomWid As Double
Dim scaleLen As Double, scaleWid As Double
Dim startLeft As Double, startTop As Double
' Set the worksheet (Change "Sheet1" if needed, or use ActiveSheet)
Set ws = ActiveSheet
' Find the last row of data in Column A
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' Starting position for the generated shapes (e.g., Column E)
startLeft = ws.Cells(2, 5).Left
startTop = ws.Cells(2, 5).Top
' Loop through the rows
For i = 2 To lastRow
' Get Data
roomName = ws.Cells(i, 1).Value
roomLen = Val(ws.Cells(i, 2).Value) ' Length
roomWid = Val(ws.Cells(i, 3).Value) ' Width
' Calculate Dimensions based on user formula: Value / 10
' We convert the result to Points assuming the result is meant to be Centimeters
' If you prefer Inches, change CentimetersToPoints to InchesToPoints
scaleLen = Application.CentimetersToPoints(roomLen / 10)
scaleWid = Application.CentimetersToPoints(roomWid / 10)
' Check to prevent creating 0-size objects
If scaleLen > 0 And scaleWid > 0 Then
' Create the Text Box Shape
' Note: In Excel, Height usually corresponds to "Length" in a vertical list,
' but for a floorplan, Width is Width and Height is Length.
Set shp = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, _
startLeft, _
startTop, _
scaleWid, _
scaleLen)
With shp
' Add Text: Name + New Line + Dims
.TextFrame2.TextRange.Text = roomName & vbNewLine & roomLen & " x " & roomWid
' Formatting
.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
.TextFrame2.VerticalAnchor = msoAnchorMiddle
.Line.Visible = msoTrue
.Line.ForeColor.RGB = RGB(0, 0, 0) ' Black Border
.Fill.ForeColor.RGB = RGB(220, 230, 241) ' Light Blue Fill
.Name = "Room_" & roomName ' Name the object for easier debugging
' Ensure text doesn't resize the shape
.TextFrame2.AutoSize = msoAutoSizeNone
.LockAspectRatio = msoFalse
End With
' Stagger position slightly so they don't pile up perfectly on top of each other
startTop = startTop + 15
startLeft = startLeft + 15
End If
Next i
MsgBox "Room generation complete!", vbInformation
End Sub
How to use this:
Press Alt + F11 to open the VBA Editor.
Go to Insert > Module.
Paste the code above into the window.
Close the VBA Editor.
Press Alt + F8, select
GenerateRoomObjects, and click Run.
Customization
If the rooms are too small or too large:
Find the lines containing
Application.CentimetersToPoints.Change to
Application.InchesToPointsfor larger shapes.Or, remove the conversion wrapper entirely if your inputs are already in printer Points (though this is unlikely).
Would you like me to add a "Snap to Grid" feature so the rooms align neatly when you drag them?
Yes, an optional "snap to grid", plus capability to change the room sizes by updating the table
Here is the updated solution.
This version introduces "Smart Updating." Instead of just creating new shapes every time (which would create duplicates), it looks for an existing shape with that Room Name.
If the shape exists: It updates the size and text but leaves the position alone (preserving your layout).
If the shape is new: It creates it at the start position.
The Macro Code
Sub UpdateOrGenerateRooms()
Dim ws As Worksheet
Dim lastRow As Long, i As Long
Dim shp As Shape
Dim roomName As String
Dim roomLen As Double, roomWid As Double
Dim scaleLen As Double, scaleWid As Double
Dim startLeft As Double, startTop As Double
Dim shapeName As String
Dim shapeExists As Boolean
Set ws = ActiveSheet
' CONFIGURATION
' Starting position for NEW shapes only
startLeft = ws.Cells(2, 5).Left
startTop = ws.Cells(2, 5).Top
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
' 1. Get Data
roomName = ws.Cells(i, 1).Value
roomLen = Val(ws.Cells(i, 2).Value)
roomWid = Val(ws.Cells(i, 3).Value)
' 2. Calculate Dimensions (Value / 10 converted to Centimeters for visibility)
scaleLen = Application.CentimetersToPoints(roomLen / 10)
scaleWid = Application.CentimetersToPoints(roomWid / 10)
' Define the unique ID for this shape based on the Room Name
shapeName = "Room_" & roomName
' 3. Check if shape already exists
shapeExists = False
On Error Resume Next
Set shp = ws.Shapes(shapeName)
If Err.Number = 0 Then shapeExists = True
On Error GoTo 0
If scaleLen > 0 And scaleWid > 0 Then
If shapeExists Then
' --- UPDATE EXISTING ---
' Only update dimensions and label, keep the user's position
With shp
.Width = scaleWid
.Height = scaleLen ' Height represents Length in floorplan view
.TextFrame2.TextRange.Text = roomName & vbNewLine & roomLen & " x " & roomWid
End With
Else
' --- CREATE NEW ---
Set shp = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, _
startLeft, startTop, scaleWid, scaleLen)
With shp
.Name = shapeName
.TextFrame2.TextRange.Text = roomName & vbNewLine & roomLen & " x " & roomWid
.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
.TextFrame2.VerticalAnchor = msoAnchorMiddle
.Line.Visible = msoTrue
.Line.ForeColor.RGB = RGB(0, 0, 0)
.Fill.ForeColor.RGB = RGB(220, 230, 241)
.TextFrame2.AutoSize = msoAutoSizeNone
.LockAspectRatio = msoFalse
End With
' Stagger start position for the NEXT new shape
startTop = startTop + 20
startLeft = startLeft + 20
End If
End If
Next i
MsgBox "Rooms updated successfully!", vbInformation
End Sub
Sub ToggleSnapToGrid()
' Excel doesn't have a simple "ActiveSheet.SnapToGrid = True" property in VBA.
' We must toggle the command bar button directly.
On Error Resume Next
Application.CommandBars.ExecuteMso "SnapToGrid"
' Give feedback on the current state
If Application.CommandBars.GetPressedMso("SnapToGrid") Then
MsgBox "Snap to Grid is now ON.", vbInformation
Else
MsgBox "Snap to Grid is now OFF.", vbInformation
End If
On Error GoTo 0
End Sub
How to use the features
1. The Update Capability
Run UpdateOrGenerateRooms whenever you change the data in columns B or C.
Scenario: You have a "Living Room" at 20x20. You dragged it to the bottom right of your screen.
Action: You change the Excel table to 30x30.
Result: When you run the macro, the "Living Room" shape stays at the bottom right, but grows larger to reflect the new dimensions.
2. Snap to Grid
Run ToggleSnapToGrid.
This presses the hidden ribbon button for "Snap to Grid."
When active, dragging your rooms will feel "magnetic," snapping to the cell corners of the worksheet.
Pro Tip: Select all cells in your floorplan area and adjust the column widths and row heights to be square (e.g., 20 pixels by 20 pixels) to create a graph-paper effect for easier snapping.
Important limitation
The "Update" logic relies on the Room Name (Column A).
If you rename "Bedroom 1" to "Master Bedroom" in the table, the macro cannot know they are the same room. It will leave "Bedroom 1" shape on the screen and create a new "Master Bedroom" shape. You will have to manually delete the old shape.
Would you like a "Reset" macro that deletes all shapes so you can start fresh?
Yes
Here is the Reset Macro.
This script is "smart"—it loops through all shapes on your worksheet and deletes only the ones that start with "Room_". This ensures you don't accidentally delete other buttons, logos, or charts you might have on the same sheet.
The Reset Macro
Sub ResetRoomShapes()
Dim ws As Worksheet
Dim shp As Shape
Dim i As Long
Dim deleteCount As Long
Set ws = ActiveSheet
deleteCount = 0
' Loop BACKWARDS through shapes.
' (Essential when deleting items from a list, otherwise Excel loses count)
For i = ws.Shapes.Count To 1 Step -1
Set shp = ws.Shapes(i)
' Check if the shape name starts with "Room_"
If Left(shp.Name, 5) = "Room_" Then
shp.Delete
deleteCount = deleteCount + 1
End If
Next i
MsgBox "Reset Complete. " & deleteCount & " room objects were removed.", vbInformation
End Sub
Summary of your Toolset
You now have three specific tools for your floor plan workflow:
UpdateOrGenerateRooms:Action: Reads the table. If a room exists, it resizes it (keeping your drag-and-drop position). If it's new, it creates it.
Use when: You change dimensions or add new rooms.
ToggleSnapToGrid:Action: Turns the "magnetic" grid snapping on or off.
Use when: You want to align rooms perfectly against cell borders.
ResetRoomShapes:Action: Deletes all floor plan shapes.
Use when: You want to scrub the board and start over completely.
Would you like me to provide a script to automatically format your worksheet cells into perfect squares (like graph paper) to make the "Snap to Grid" feature much more effective?
Yes
Here is the Graph Paper Macro.
This script avoids Columns A, B, and C (your data) and applies a square grid starting from Column E (your "canvas"). It uses a calibration loop to ensure the cells are actually square, as Excel uses different units for width (characters) and height (points).
The Macro
Sub CreateGraphPaperGrid()
Dim ws As Worksheet
Dim gridRange As Range
Dim targetSize As Double
Dim testCell As Range
Set ws = ActiveSheet
' CONFIGURATION
' Target size in Points (20 points is approx 0.7 cm or 0.28 inches)
' This is a good size for "snapping" rooms comfortably.
targetSize = 20
' Define the canvas area (Columns E to BZ, Rows 2 to 100)
Set gridRange = ws.Range("E2:BZ100")
Application.ScreenUpdating = False
' 1. Set Row Height (Easy, as it uses Points directly)
gridRange.RowHeight = targetSize
' 2. Calibrate Column Width (Hard, as it uses "Characters")
' We use a temporary test cell to find the perfect width ratio
Set testCell = ws.Range("E2")
testCell.ColumnWidth = 1 ' Start small
' Loop: Slightly increase width until the Point width matches the Target
Do While testCell.Width < targetSize
testCell.ColumnWidth = testCell.ColumnWidth + 0.1
Loop
' Apply the calculated width to the whole grid area
gridRange.Columns.ColumnWidth = testCell.ColumnWidth
' 3. Optional: Add light borders to make it look like real graph paper
With gridRange.Borders
.LineStyle = xlContinuous
.Weight = xlThin
.Color = RGB(230, 230, 230) ' Very light gray
End With
Application.ScreenUpdating = True
MsgBox "Canvas area (E2:BZ100) formatted as graph paper!", vbInformation
End Sub
Recommended Workflow
Run
CreateGraphPaperGridfirst to set up your board.Run
ToggleSnapToGridto turn on the "magnetism."Run
UpdateOrGenerateRoomsto drop your room shapes onto the grid.
One Final Helper: "Get Layout Coordinates"
Since you are arranging these rooms visually, you might eventually want to know where you placed them (e.g., to save the layout).
Would you like a final macro that writes the X and Y coordinates of the placed shapes back into your Excel table (e.g., into Columns D and E)?
Yes
Here is the Save Layout Macro.
This script loops through your table, finds the corresponding shape on the screen, and records its exact X (Left) and Y (Top) position into Columns D and E.
The Macro
Sub SaveLayoutCoordinates()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim roomName As String
Dim shpName As String
Dim shp As Shape
Set ws = ActiveSheet
' Find the last row of data
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' Add Headers to Columns D and E
ws.Cells(1, 4).Value = "X Pos"
ws.Cells(1, 5).Value = "Y Pos"
' Loop through the list of rooms
For i = 2 To lastRow
roomName = ws.Cells(i, 1).Value
shpName = "Room_" & roomName
' Reset shape object
Set shp = Nothing
' Try to find the shape
On Error Resume Next
Set shp = ws.Shapes(shpName)
On Error GoTo 0
' If shape was found, write coordinates to table
If Not shp Is Nothing Then
' Writing values rounded to 1 decimal place for cleaner data
ws.Cells(i, 4).Value = Round(shp.Left, 1)
ws.Cells(i, 5).Value = Round(shp.Top, 1)
Else
' If shape is missing, clear the coordinate cells or mark as missing
ws.Cells(i, 4).Value = ""
ws.Cells(i, 5).Value = ""
End If
Next i
MsgBox "Current layout coordinates saved to Columns D and E.", vbInformation
End Sub
The Completed Workflow
You now have a full "Round Trip" system:
Data to Visual: You enter dimensions in Columns A, B, C and run
UpdateOrGenerateRooms.Organize: You drag the rooms around on your graph paper grid.
Visual to Data: You run
SaveLayoutCoordinatesto write the positions back to the table.
A High-Value Improvement
Right now, if you run the Reset macro (deleting all shapes), you lose your layout. Even though you saved the coordinates in Columns D and E, the original generation script doesn't know how to read them.
Would you like me to rewrite the original UpdateOrGenerateRooms macro one last time so that it looks at Columns D and E first? (This would allow you to delete all shapes, send the Excel file to a colleague, and have them click one button to perfectly reconstruct your exact floor plan layout.)
Yes
Here is the Final "Master" Macro.
This replaces your previous UpdateOrGenerateRooms. It now completes the cycle: it checks if you have saved coordinates in Columns D and E. If it finds them, it restores the room to that exact spot. If not, it places the room in the default starting area.
The Master Macro
Sub UpdateGenerateAndRestoreRooms()
Dim ws As Worksheet
Dim lastRow As Long, i As Long
Dim shp As Shape
Dim roomName As String
Dim roomLen As Double, roomWid As Double
Dim scaleLen As Double, scaleWid As Double
Dim startLeft As Double, startTop As Double
Dim savedLeft As Variant, savedTop As Variant ' Variant to check for Empty cells
Dim shapeName As String
Dim shapeExists As Boolean
Set ws = ActiveSheet
' CONFIGURATION
' Default starting position for rooms that have NO saved coordinates
' (We use Column G now to keep it clear of the data table)
startLeft = ws.Cells(2, 7).Left
startTop = ws.Cells(2, 7).Top
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
' 1. Get Data
roomName = ws.Cells(i, 1).Value
roomLen = Val(ws.Cells(i, 2).Value)
roomWid = Val(ws.Cells(i, 3).Value)
' 2. Calculate Dimensions (Value / 10 converted to Centimeters)
scaleLen = Application.CentimetersToPoints(roomLen / 10)
scaleWid = Application.CentimetersToPoints(roomWid / 10)
' 3. Get Saved Coordinates (if any)
savedLeft = ws.Cells(i, 4).Value
savedTop = ws.Cells(i, 5).Value
shapeName = "Room_" & roomName
' 4. Check if shape currently exists on screen
shapeExists = False
On Error Resume Next
Set shp = ws.Shapes(shapeName)
If Err.Number = 0 Then shapeExists = True
On Error GoTo 0
If scaleLen > 0 And scaleWid > 0 Then
If shapeExists Then
' --- SCENARIO A: Shape is already on screen ---
' Update size only. Trust the current position on screen over the table.
With shp
.Width = scaleWid
.Height = scaleLen
.TextFrame2.TextRange.Text = roomName & vbNewLine & roomLen & " x " & roomWid
End With
Else
' --- SCENARIO B: Shape is missing (New or Deleted) ---
' Create the shape first
Set shp = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, _
0, 0, scaleWid, scaleLen) ' Pos 0,0 temporarily
' Apply formatting
With shp
.Name = shapeName
.TextFrame2.TextRange.Text = roomName & vbNewLine & roomLen & " x " & roomWid
.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
.TextFrame2.VerticalAnchor = msoAnchorMiddle
.Line.Visible = msoTrue
.Line.ForeColor.RGB = RGB(0, 0, 0)
.Fill.ForeColor.RGB = RGB(220, 230, 241)
.TextFrame2.AutoSize = msoAutoSizeNone
.LockAspectRatio = msoFalse
End With
' Determine Position
If IsEmpty(savedLeft) Or IsEmpty(savedTop) Or (savedLeft = "" And savedTop = "") Then
' No saved coords? Use the default "pile" location
shp.Left = startLeft
shp.Top = startTop
' Stagger the next default one
startTop = startTop + 20
startLeft = startLeft + 20
Else
' Found saved coords! Restore exact position.
shp.Left = savedLeft
shp.Top = savedTop
End If
End If
End If
Next i
MsgBox "Rooms updated and positions restored!", vbInformation
End Sub
Your Full "Application"
You now have a fully functional Floor Plan Application within Excel.
| Macro Name | Purpose |
| UpdateGenerateAndRestoreRooms | The Main Button. Updates sizes, adds new rooms, and restores deleted rooms to their saved positions. |
| SaveLayoutCoordinates | The Save Button. Writes the current screen positions into Columns D and E. |
| ResetRoomShapes | The Clear Button. Deletes all room shapes (safe to do now, provided you saved coordinates first!). |
| CreateGraphPaperGrid | One-time setup to create square cells. |
| ToggleSnapToGrid | Toggles the magnetic alignment. |
Final Polish
Currently, you have to press Alt+F8 to run these. To make this user-friendly (drag-and-drop ready):
Would you like me to walk you through how to add simple Buttons (Start, Save, Reset) directly onto the sheet so you don't have to use the macro menu?
Yes, buttons for all actions
Here is the step-by-step guide to building your "Control Panel."
Since we wrote the Reset macro to only delete shapes starting with "Room_", your buttons are safe. They will not be deleted when you clear the board.
Step 1: Ensure the "Developer" Tab is Visible
If you don't see a tab named Developer at the top of Excel:
Right-click anywhere on the Ribbon (the menu bar).
Select Customize the Ribbon...
On the right side list, check the box next to Developer.
Click OK.
Step 2: Create the Buttons
We will use "Form Controls" because they are robust and easiest to link to macros.
Go to the Developer tab.
Click Insert (the toolbox icon).
Under "Form Controls" (the top section), click the first icon (the Button).
Draw the button on your sheet (I recommend placing them in Columns G, H, or I, near the top).
When you release the mouse, the "Assign Macro" window will pop up automatically.
Select the macro and click OK.
Rename the button: Right-click the button, select "Edit Text", and type a friendly name.
Repeat this process 5 times for your 5 tools:
| Button Label | Assign to Macro | Color Idea (Optional) |
| UPDATE / RESTORE | UpdateGenerateAndRestoreRooms | (Main Action) |
| SAVE LAYOUT | SaveLayoutCoordinates | (Crucial Step) |
| CLEAR BOARD | ResetRoomShapes | (Warning Step) |
| Toggle Snap | ToggleSnapToGrid | (Utility) |
| Fix Grid Size | CreateGraphPaperGrid | (Utility) |
Step 3: Recommended Layout ("The Dashboard")
To keep your tool clean, I suggest arranging your worksheet like this:
Columns A-C: Your Data Input (Room Name, Length, Width).
Columns D-E: The Saved Coordinates (Don't touch these manually!).
Column F: Empty (Spacer).
Columns G-I (Rows 1-5): Place your Buttons here.
Columns E-BZ (Row 6+): Your Floor Plan Canvas.
Step 4: Pro-Tip (Locking the Buttons)
By default, if you resize columns, your buttons might squash or stretch. To fix this:
Right-click a button.
Select Format Control.
Go to the Properties tab.
Select "Don't move or size with cells".
Click OK.
Summary of your new Workflow
Input: Type your room dimensions in Columns A-C.
Click "Fix Grid Size": (Only needed once per sheet).
Click "Toggle Snap": To turn on the magnetic grid.
Click "UPDATE / RESTORE": Your rooms appear.
Design: Drag the rooms to arrange your floor plan.
Click "SAVE LAYOUT": The positions are recorded in the table.
The system is now feature-complete.
Would you like to add Conditional Formatting to the macro? For example, if you add a "Type" column (Bedroom, Wet Room, Living), the macro could automatically color the rooms (e.g., Blue for bathrooms, Green for living areas)?
Yes
Here is the updated code suite to support Color Coding.
Step 1: Update your Excel Table Structure
To make room for the "Type" data, we need to shift the "Saved Coordinates" over by one column.
Your new table layout (Columns A - F):
A: Room Name
B: Length
C: Width
D: Type (e.g., "Bedroom", "Kitchen", "Hall") <--- NEW
E: X Pos
F: Y Pos
Step 2: The Color-Coding Macro
Replace your existing UpdateGenerateAndRestoreRooms with this version. It now includes a Select Case block that checks Column D and applies colors dynamically.
Sub UpdateGenerateRestoreAndColor()
Dim ws As Worksheet
Dim lastRow As Long, i As Long
Dim shp As Shape
Dim roomName As String, roomType As String
Dim roomLen As Double, roomWid As Double
Dim scaleLen As Double, scaleWid As Double
Dim startLeft As Double, startTop As Double
Dim savedLeft As Variant, savedTop As Variant
Dim shapeName As String
Dim shapeExists As Boolean
Dim roomColor As Long
Set ws = ActiveSheet
' CONFIGURATION: Start Position for NEW shapes (Column H)
startLeft = ws.Cells(2, 8).Left
startTop = ws.Cells(2, 8).Top
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
' 1. Get Data (Note new column for Type)
roomName = ws.Cells(i, 1).Value
roomLen = Val(ws.Cells(i, 2).Value)
roomWid = Val(ws.Cells(i, 3).Value)
roomType = LCase(Trim(ws.Cells(i, 4).Value)) ' Clean input
' 2. Determine Color based on Type
Select Case roomType
' WET ROOMS (Blue)
Case "kitchen", "bath", "bathroom", "wc", "utility", "wet"
roomColor = RGB(189, 215, 238)
' LIVING AREAS (Green)
Case "living", "lounge", "dining", "family", "den"
roomColor = RGB(198, 224, 180)
' SLEEPING (Orange/Peach)
Case "bedroom", "guest", "master", "nursery"
roomColor = RGB(248, 203, 173)
' CIRCULATION (Gray)
Case "hall", "corridor", "entry", "foyer", "stairs"
roomColor = RGB(217, 217, 217)
' DEFAULT (White/Light Blue)
Case Else
roomColor = RGB(221, 235, 247)
End Select
' 3. Calc Dimensions
scaleLen = Application.CentimetersToPoints(roomLen / 10)
scaleWid = Application.CentimetersToPoints(roomWid / 10)
' 4. Get Coordinates (Shifted to Col E and F)
savedLeft = ws.Cells(i, 5).Value
savedTop = ws.Cells(i, 6).Value
shapeName = "Room_" & roomName
' Check if exists
shapeExists = False
On Error Resume Next
Set shp = ws.Shapes(shapeName)
If Err.Number = 0 Then shapeExists = True
On Error GoTo 0
If scaleLen > 0 And scaleWid > 0 Then
If shapeExists Then
' --- UPDATE EXISTING ---
With shp
.Width = scaleWid
.Height = scaleLen
.TextFrame2.TextRange.Text = roomName & vbNewLine & roomLen & " x " & roomWid
.Fill.ForeColor.RGB = roomColor ' Update Color
End With
Else
' --- CREATE NEW ---
Set shp = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, scaleWid, scaleLen)
With shp
.Name = shapeName
.TextFrame2.TextRange.Text = roomName & vbNewLine & roomLen & " x " & roomWid
.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
.TextFrame2.VerticalAnchor = msoAnchorMiddle
.Line.Visible = msoTrue
.Line.ForeColor.RGB = RGB(0, 0, 0)
.Fill.ForeColor.RGB = roomColor ' Set Color
.TextFrame2.AutoSize = msoAutoSizeNone
.LockAspectRatio = msoFalse
End With
' Position Logic
If IsEmpty(savedLeft) Or IsEmpty(savedTop) Or (savedLeft = "" And savedTop = "") Then
shp.Left = startLeft
shp.Top = startTop
startTop = startTop + 20
startLeft = startLeft + 20
Else
shp.Left = savedLeft
shp.Top = savedTop
End If
End If
End If
Next i
MsgBox "Rooms updated, colored, and restored!", vbInformation
End Sub
Step 3: Update the Save Macro
We must update the save macro to look at the new columns (E and F) so it doesn't overwrite your "Type" data.
Sub SaveLayoutCoordinates()
Dim ws As Worksheet
Dim lastRow As Long, i As Long
Dim roomName As String, shpName As String
Dim shp As Shape
Set ws = ActiveSheet
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' Update Headers
ws.Cells(1, 5).Value = "X Pos"
ws.Cells(1, 6).Value = "Y Pos"
For i = 2 To lastRow
roomName = ws.Cells(i, 1).Value
shpName = "Room_" & roomName
Set shp = Nothing
On Error Resume Next
Set shp = ws.Shapes(shpName)
On Error GoTo 0
If Not shp Is Nothing Then
' Save to Columns E (5) and F (6)
ws.Cells(i, 5).Value = Round(shp.Left, 1)
ws.Cells(i, 6).Value = Round(shp.Top, 1)
Else
ws.Cells(i, 5).Value = ""
ws.Cells(i, 6).Value = ""
End If
Next i
MsgBox "Layout saved to Columns E and F.", vbInformation
End Sub
How to Customize the Colors
Look at the Select Case section in the first macro.
You can add more keywords (e.g.,
"garage", "patio").You can change the RGB codes.
Tip: To find an RGB code, go to Excel Home Tab > Fill Color > More Colors > Custom. It will show you the Red, Green, and Blue numbers to type into the macro.
Would you like me to write a small helper utility that lists all the Shapes currently on your sheet along with their current dimensions? (This is helpful if you resized a room by dragging the corner with your mouse and want to update the table to match the visual size).
Yes
Here is the "Reverse Sync" Macro.
This is a powerful tool for your workflow. It allows you to drag the resize handles of a room on the screen (to make it fit a specific space visually) and then click a button to force those new dimensions back into your Excel table.
The Macro
Sub SyncVisualSizesToTable()
Dim ws As Worksheet
Dim lastRow As Long, i As Long
Dim shp As Shape
Dim roomName As String, shpName As String
Dim currentLen As Double, currentWid As Double
Dim newLen As Double, newWid As Double
Dim count As Long
Set ws = ActiveSheet
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
count = 0
' SAFETY CHECK: Ask for permission before overwriting data
If MsgBox("This will overwrite the Dimensions in Columns B and C " & _
"with the current size of the shapes on screen." & vbNewLine & vbNewLine & _
"Are you sure?", vbYesNo + vbExclamation, "Sync Visual Sizes") = vbNo Then
Exit Sub
End If
For i = 2 To lastRow
roomName = ws.Cells(i, 1).Value
shpName = "Room_" & roomName
' Reset shape
Set shp = Nothing
On Error Resume Next
Set shp = ws.Shapes(shpName)
On Error GoTo 0
If Not shp Is Nothing Then
' 1. Capture current table values (for comparison/logging if needed)
currentLen = Val(ws.Cells(i, 2).Value)
currentWid = Val(ws.Cells(i, 3).Value)
' 2. Calculate new values from Shape
' Formula: (Points converted to CM) * 10
' Note: We map Shape.Height to Table Length (Column B)
newLen = Round(Application.PointsToCentimeters(shp.Height) * 10, 2)
newWid = Round(Application.PointsToCentimeters(shp.Width) * 10, 2)
' 3. Overwrite Table Data
ws.Cells(i, 2).Value = newLen
ws.Cells(i, 3).Value = newWid
' 4. Update the text label on the shape immediately to match
shp.TextFrame2.TextRange.Text = roomName & vbNewLine & newLen & " x " & newWid
count = count + 1
End If
Next i
MsgBox "Sync Complete. " & count & " rows were updated to match the visual layout.", vbInformation
End Sub
Updates to your Dashboard
You should add one final button to your control panel:
| Button Label | Assign to Macro | Purpose |
| SYNC SIZE | SyncVisualSizesToTable | Reads the screen shape size and updates Columns B & C. |
The Final Workflow Cycle
You now have a complete bi-directional application:
Type Data: Enter "Kitchen", 40, 40.
Update: Click
UPDATE / RESTORE. Shape appears.Visual Edit: You realize the kitchen needs to be rectangular to fit. You drag the shape handle to stretch it.
Sync Data: You click
SYNC SIZE. Excel updates the table to "Kitchen", 40, 65.2.Save Layout: You click
SAVE LAYOUTto remember where you put it.
One Critical Requirement: File Type
Because you are using macros, you cannot save this as a standard Excel Workbook (.xlsx). You must save the file as an Excel Macro-Enabled Workbook (.xlsm).
Go to File > Save As.
Change the file type dropdown to Excel Macro-Enabled Workbook (*.xlsm).
Would you like me to generate a summary "User Guide" text block that you can paste into a text box on the Excel sheet, so you (or others) remember how to use the tool in the future?
Yes
Here is a formatted User Guide. You can copy this text, draw a large Text Box in your Excel sheet (e.g., in Columns G-I), and paste it inside for easy reference.
🏠 FLOOR PLAN DESIGNER – USER GUIDE
1. DATA SETUP (Columns A - F)
A (Name): Unique name for the room (e.g., "Kitchen").
B (Length) & C (Width): Dimensions of the room.
D (Type): Determines color. Use: Bedroom, Kitchen, Living, Bath, Hall.
E & F (Coords): DO NOT EDIT. These store the saved screen positions.
2. BUTTON FUNCTIONS
UPDATE / RESTORE: The main button. Creates new rooms, resizes existing ones, applies colors, and moves them to their saved positions (from Cols E/F).
SAVE LAYOUT: Writes the current location of every room on the screen into Columns E & F. Press this before closing!
SYNC SIZE: Updates the table (Cols B & C) to match the visual size of the shapes. Use this if you stretched a room with your mouse.
TOGGLE SNAP: Turns "Snap to Grid" on/off for precise alignment.
FIX GRID: Formats the canvas (Col E+) into perfect squares.
3. COLOR KEY (Column D)
Blue: Kitchen, Bath, Utility, Wet
Green: Living, Lounge, Dining, Family
Peach: Bedroom, Guest, Master
Gray: Hall, Corridor, Entry
4. TYPICAL WORKFLOW
Add/Edit your data in the table.
Click UPDATE to generate the shapes.
Drag & Drop to arrange your floor plan.
(Optional) Resize shapes visually, then click SYNC SIZE.
Click SAVE LAYOUT to store the arrangement.
Next Step
You now have a fully programmed application. Since this relies on VBA, remember that if you email this file to a colleague, they might have to click "Enable Content" or "Enable Macros" in the yellow security bar at the top of Excel when they first open it.
Would you like me to show you how to protect the sheet so that users can move the shapes, but cannot accidentally delete your buttons or break the formulas?
Rewrite the entire application as HTML, JavaScript and CSS
This is a complete transformation of your tool into a standalone Single Page Web Application.
It combines the table data entry, the visual canvas, the snap-to-grid logic, and the color coding into one file.
How to use this:
Copy the code block below.
Paste it into a text editor (Notepad, TextEdit, VS Code).
Save the file as
floorplanner.html.Double-click the file to open it in your browser (Chrome, Edge, Firefox).
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="UTF-8">
<meta name="viewport" content="width=device-width, initial-scale=1.0">
<title>Web Floor Plan Designer</title>
<style>
:root {
--grid-size: 20px;
--sidebar-width: 350px;
--bg-color: #f4f4f9;
--header-bg: #2c3e50;
--text-color: #333;
}
body {
margin: 0;
padding: 0;
font-family: 'Segoe UI', Tahoma, Geneva, Verdana, sans-serif;
display: flex;
height: 100vh;
overflow: hidden;
background-color: var(--bg-color);
}
/* --- SIDEBAR (DATA) --- */
#sidebar {
width: var(--sidebar-width);
background: white;
border-right: 1px solid #ccc;
display: flex;
flex-direction: column;
box-shadow: 2px 0 5px rgba(0,0,0,0.1);
z-index: 10;
}
.header {
background: var(--header-bg);
color: white;
padding: 15px;
text-align: center;
}
.controls {
padding: 10px;
background: #eee;
border-bottom: 1px solid #ddd;
display: flex;
gap: 10px;
flex-wrap: wrap;
}
button {
padding: 8px 12px;
cursor: pointer;
background: #fff;
border: 1px solid #bbb;
border-radius: 4px;
font-size: 13px;
flex: 1;
}
button:hover { background: #f0f0f0; }
button.primary { background: #3498db; color: white; border-color: #2980b9; }
button.danger { background: #e74c3c; color: white; border-color: #c0392b; }
button.active {
background: #27ae60;
color: white;
border-color: #2ecc71;
}
.table-container {
flex: 1;
overflow-y: auto;
padding: 10px;
}
table {
width: 100%;
border-collapse: collapse;
font-size: 13px;
}
th { text-align: left; padding: 5px; background: #f8f9fa; position: sticky; top: 0; }
td { border-bottom: 1px solid #eee; padding: 5px 2px; }
input[type="text"], input[type="number"] {
width: 100%;
padding: 4px;
box-sizing: border-box;
border: 1px solid #ddd;
border-radius: 3px;
}
input[type="number"] { width: 50px; }
/* --- CANVAS (VISUAL) --- */
#canvas {
flex: 1;
position: relative;
background-color: #fff;
/* Graph Paper CSS */
background-size: var(--grid-size) var(--grid-size);
background-image:
linear-gradient(to right, #e0e0e0 1px, transparent 1px),
linear-gradient(to bottom, #e0e0e0 1px, transparent 1px);
overflow: auto;
}
.room {
position: absolute;
border: 1px solid rgba(0,0,0,0.5);
display: flex;
flex-direction: column;
align-items: center;
justify-content: center;
font-size: 12px;
text-align: center;
cursor: grab;
box-shadow: 2px 2px 5px rgba(0,0,0,0.2);
user-select: none;
overflow: hidden;
/* Allow resizing natively in CSS */
resize: both;
min-width: 20px;
min-height: 20px;
}
.room:active {
cursor: grabbing;
opacity: 0.9;
z-index: 1000;
}
/* Room Colors based on Type */
.type-kitchen, .type-bath, .type-utility { background-color: #bdd7ee; } /* Blue */
.type-living, .type-dining { background-color: #c6e0b4; } /* Green */
.type-bedroom { background-color: #f8cbad; } /* Peach */
.type-hall { background-color: #d9d9d9; } /* Gray */
.type-default { background-color: #ddebf7; } /* Default */
</style>
</head>
<body>
<div id="sidebar">
<div class="header">
<h3>Floor Plan Designer</h3>
</div>
<div class="controls">
<button class="primary" onclick="renderRoomsFromTable()">Update Canvas</button>
<button id="snapBtn" class="active" onclick="toggleSnap()">Snap: ON</button>
</div>
<div class="controls">
<button onclick="addRow()">+ Add Room</button>
<button onclick="saveData()">Save Data</button>
<button class="danger" onclick="resetAll()">Reset</button>
</div>
<div class="table-container">
<table id="dataTable">
<thead>
<tr>
<th style="width: 30%">Name</th>
<th>L</th>
<th>W</th>
<th style="width: 25%">Type</th>
<th></th>
</tr>
</thead>
<tbody id="tableBody">
</tbody>
</table>
</div>
</div>
<div id="canvas">
</div>
<script>
// --- CONFIGURATION ---
const PIXELS_PER_UNIT = 10; // 1 Table Unit = 10 Pixels on screen (User asked for /10 logic)
const SNAP_SIZE = 20; // Grid Size
let isSnapEnabled = true;
// Default Data
let rooms = [
{ id: 1, name: "Living", len: 50, wid: 40, type: "living", x: 40, y: 40 },
{ id: 2, name: "Kitchen", len: 30, wid: 30, type: "kitchen", x: 260, y: 40 },
{ id: 3, name: "Bedroom 1", len: 35, wid: 30, type: "bedroom", x: 40, y: 300 }
];
// --- INITIALIZATION ---
window.onload = function() {
loadData();
renderTable();
renderRoomsFromTable();
};
// --- CORE FUNCTIONS ---
function toggleSnap() {
isSnapEnabled = !isSnapEnabled;
const btn = document.getElementById('snapBtn');
btn.className = isSnapEnabled ? 'active' : '';
btn.innerText = isSnapEnabled ? 'Snap: ON' : 'Snap: OFF';
}
// 1. RENDER TABLE (Left Side)
function renderTable() {
const tbody = document.getElementById('tableBody');
tbody.innerHTML = '';
rooms.forEach((room, index) => {
const tr = document.createElement('tr');
tr.innerHTML = `
<td><input type="text" value="${room.name}" onchange="updateData(${index}, 'name', this.value)"></td>
<td><input type="number" value="${room.len}" onchange="updateData(${index}, 'len', this.value)"></td>
<td><input type="number" value="${room.wid}" onchange="updateData(${index}, 'wid', this.value)"></td>
<td><input type="text" value="${room.type}" onchange="updateData(${index}, 'type', this.value)"></td>
<td><button style="padding:2px 5px;" onclick="deleteRow(${index})">x</button></td>
`;
tbody.appendChild(tr);
});
}
// 2. RENDER CANVAS (Right Side)
function renderRoomsFromTable() {
const canvas = document.getElementById('canvas');
canvas.innerHTML = ''; // Clear existing
rooms.forEach((room, index) => {
const el = document.createElement('div');
el.classList.add('room');
el.id = `room-${index}`;
// Set Color Class
const type = room.type.toLowerCase();
if (type.includes('kitchen') || type.includes('bath')) el.classList.add('type-kitchen');
else if (type.includes('living') || type.includes('dining')) el.classList.add('type-living');
else if (type.includes('bed')) el.classList.add('type-bedroom');
else if (type.includes('hall')) el.classList.add('type-hall');
else el.classList.add('type-default');
// Dimensions (User Formula: Length/10).
// We use PIXELS_PER_UNIT as a visual multiplier so it's not microscopic.
// Assuming "Length/10" meant coordinate units.
// Let's treat input 40 as 400px or 40px depending on preference.
// Based on VBA prompt: "text object of length=Length/10".
// If Length is 40, VBA makes it 4 points (tiny). We fixed that in VBA using CM.
// Here: Input 40 -> 400px width seems huge. Input 40 -> 40px seems reasonable.
// Let's use 1 Input Unit = 5px for a good balance on screen.
// Actually, let's stick to strict user input for consistency with grid:
// If grid is 20px, let's map input directly to pixels so 20 input = 1 grid square.
el.style.width = room.wid + 'px';
el.style.height = room.len + 'px'; // In floorplans, Length is usually Y axis (Height)
// Position
el.style.left = room.x + 'px';
el.style.top = room.y + 'px';
// Content
el.innerHTML = `<strong>${room.name}</strong><br><span id="dim-${index}">${room.len} x ${room.wid}</span>`;
// Add Interaction
makeInteractable(el, index);
canvas.appendChild(el);
});
}
// --- INTERACTION LOGIC (Drag & Resize) ---
function makeInteractable(el, index) {
let isDragging = false;
let startX, startY, initLeft, initTop;
// DRAG START
el.addEventListener('mousedown', (e) => {
// Ignore if clicking the resize handle (bottom right corner)
if (e.offsetX > el.offsetWidth - 10 && e.offsetY > el.offsetHeight - 10) return;
isDragging = true;
startX = e.clientX;
startY = e.clientY;
initLeft = el.offsetLeft;
initTop = el.offsetTop;
el.style.zIndex = 1000;
});
// DRAGGING
window.addEventListener('mousemove', (e) => {
if (!isDragging) return;
let dx = e.clientX - startX;
let dy = e.clientY - startY;
let newLeft = initLeft + dx;
let newTop = initTop + dy;
if (isSnapEnabled) {
newLeft = Math.round(newLeft / SNAP_SIZE) * SNAP_SIZE;
newTop = Math.round(newTop / SNAP_SIZE) * SNAP_SIZE;
}
el.style.left = newLeft + 'px';
el.style.top = newTop + 'px';
});
// DRAG END
window.addEventListener('mouseup', (e) => {
if (isDragging) {
isDragging = false;
el.style.zIndex = '';
// Save Position
rooms[index].x = parseInt(el.style.left);
rooms[index].y = parseInt(el.style.top);
saveData();
}
});
// RESIZE OBSERVER (The "Reverse Sync" logic)
// Monitors if the user dragged the corner of the div
new ResizeObserver(entries => {
for (let entry of entries) {
const newW = Math.round(entry.contentRect.width);
const newH = Math.round(entry.contentRect.height);
// Update Model
// Only update if significantly changed (prevent loop on initial render)
if (Math.abs(newW - rooms[index].wid) > 2 || Math.abs(newH - rooms[index].len) > 2) {
rooms[index].wid = newW;
rooms[index].len = newH;
// Update Table Inputs
renderTable();
// Update Label on Box
const span = document.getElementById(`dim-${index}`);
if(span) span.innerText = `${newH} x ${newW}`;
}
}
}).observe(el);
}
// --- DATA MANAGEMENT ---
function updateData(index, field, value) {
rooms[index][field] = value;
// If dimensions changed in table, redraw canvas
if (field === 'len' || field === 'wid' || field === 'type' || field === 'name') {
renderRoomsFromTable();
}
}
function addRow() {
rooms.push({
id: Date.now(),
name: "New Room",
len: 40,
wid: 40,
type: "",
x: 20,
y: 20
});
renderTable();
renderRoomsFromTable();
}
function deleteRow(index) {
rooms.splice(index, 1);
renderTable();
renderRoomsFromTable();
}
function resetAll() {
if(confirm("Clear all data?")) {
rooms = [];
renderTable();
renderRoomsFromTable();
saveData();
}
}
function saveData() {
localStorage.setItem('floorPlanData', JSON.stringify(rooms));
}
function loadData() {
const saved = localStorage.getItem('floorPlanData');
if (saved) {
rooms = JSON.parse(saved);
}
}
</script>
</body>
</html>
Key Differences & Improvements vs. VBA
Simultaneous Bi-Directional Sync:
In VBA, you had to click "Sync Size". Here, if you drag the bottom-right corner of a room, the table on the left updates instantly.
If you type in the table, the room on the right updates instantly.
No Security Warnings: Because this is standard HTML/JS, you don't need to enable Macros or worry about
.xlsmsecurity blocks.Local Storage: The
saveData()function saves your layout to your browser's Local Storage. If you refresh the page, your rooms will still be there.CSS Resizing: I used the native CSS property
resize: both, which adds a small handle to the bottom-right of every room automatically.
Customization
Scale: Look for
const PIXELS_PER_UNIT = 10;. You can change this if you want the input number10to result in a 20px box instead of a 10px box.Grid Size: Look for
const SNAP_SIZE = 20;. Change this to make the snap grid tighter or looser.
From <https://gemini.google.com/app/> Google Gemini 3.0 Pro (Thinking)
GenerateRoomObjectsUpdateOrGenerateRoomsToggleSnapToGrid
ResetRoomShapes
CreateGraphPaperGrid
UpdateGenerateAndRestoreRooms
SaveLayoutCoordinates
SyncVisualSizesToTable
UpdateGenerateRestoreAndColor
Comments
Post a Comment