Excel VBA: Adding Rows and Columns Based on User Input

Question

I'm trying to build a table based upon user inputs: number of Areas, number of Floors, and number of Buildings. It should automatically create the table based on user input.

example of an output would be:

I figured out how to use vba to copy/paste X Amount of columns (buildings) based on user input and I figured out how to use the filldown in vba for the areas, but I can't get past adding floors automatically, and I can't tie it all together in the table. I would normally not even both with something like this, but it's an ask from the leadership team. My VBA skills (and imagination) have hit a wall.

example of code for the columns being added:

Private Sub cmd_Button_Columns_Click()
'  Add Buildings

Dim N As Integer

N = Range("A2").Value


Select Case N

Case 1

' Copy_Sheet = "Employing VBA Macros"
Copy_Cell = "f1:i7"
' Paste_Sheet = "Employing VBA Macros"
Paste_Cell = "k1:n7"
' Worksheets(Copy_Sheet).Range(Copy_Cell).Copy
Me.Range(Copy_Cell).Copy
' Worksheets(Paste_Sheet).Range(Paste_Cell).PasteSpecial
Me.Range(Paste_Cell).PasteSpecial Paste:=xlPasteAll



Case 2

Copy_Cell = "f1:i7"

Paste_Cell = "k1:n7"

Me.Range(Copy_Cell).Copy

Me.Range(Paste_Cell).PasteSpecial Paste:=xlPasteAll

Paste_Cell = "p1:s7"

Me.Range(Paste_Cell).PasteSpecial Paste:=xlPasteAll



Case 3

Copy_Cell = "f1:i7"

Paste_Cell = "k1:n7"

Me.Range(Copy_Cell).Copy

Me.Range(Paste_Cell).PasteSpecial Paste:=xlPasteAll

Paste_Cell = "p1:s7"

Me.Range(Paste_Cell).PasteSpecial Paste:=xlPasteAll

Paste_Cell = "u1:x7"

Me.Range(Paste_Cell).PasteSpecial Paste:=xlPasteAll



Case 0
Range("k1:z7").ClearContents


End Select

End Sub

And for the rows I tried the following:

Sub Add_Areas()
' Add Areas

Dim Resizer As Integer
Dim a As Variant
a = InputBox("Please enter the MAX number of Areas for your project", "NUMBER OF AREAS") 'First we ask for user input

On Error GoTo notvalid  'We add an error handler, so if the user would enter text like "seven", the sub will exit with a message
Resizer = CInt(a)       'we store the input in a variable which has to be an integer, if the user enters text it will couse an error so we jump to the end
If Resizer < 2 Then GoTo notvalid 'We also check if the number is higher than 1, othervise it couses error, or copies the 19th row to the 20th
On Error GoTo 0 'We reset the error handling so we can see if something else goes wrong.

ThisWorkbook.Sheets("Sheet1").Visible = True
ThisWorkbook.Sheets("Sheet1").Select
ThisWorkbook.Sheets("Sheet1").Rows(20 + 1).EntireRow.Insert shift:=xlDown 'add a new row under the 20th row/above the 21st row
ThisWorkbook.Sheets("Sheet1").Rows(20).Resize(Resizer).FillDown
  Exit Sub    'We exit the sub before the error message.
notvalid: 'in case of error we jump here
    MsgBox "Please enter a number which is 2 or higher"
End Sub

Answer 1

• Using nested loops to populate the output array
• Write output to sheet for each building
• Merge cells and apply formatting

Microsoft documentation:

Range.Offset property (Excel)

Range.Resize property (Excel)

Range.HorizontalAlignment property (Excel)

Option Explicit
Sub Demo()
    Dim iBldg As Long, iFloor As Long, iArea As Long
    Dim arrRes, iR As Long, i As Long, j As Long
    Dim rCell As Range
    Const START_CELL = "C1"
    iBldg = Range("B1")
    iFloor = Range("B2")
    iArea = Range("B3")
    ReDim arrRes(iFloor * iArea + 1, 2)
    arrRes(1, 0) = "Floor"
    arrRes(1, 1) = "Area"
    iR = 1
    For i = 1 To iFloor
        For j = 1 To iArea
            iR = iR + 1
            If j = 1 Then arrRes(iR, 0) = i
            arrRes(iR, 1) = j
        Next
    Next
    Set rCell = Range(START_CELL)
    For i = 1 To iBldg
        With rCell
            .Resize(UBound(arrRes) + 1, 3).Value = arrRes
            .Value = "Building " & i
            .Resize(, 3).Merge
            .MergeArea.EntireColumn.HorizontalAlignment = xlCenter
            Set rCell = .Offset(, 1)
        End With
    Next
End Sub