Buttons To Add A Row and Add A column Bug? - vba

Question

I have a table as you can see in the image. The add row and add column button when pressed takes a user input meaning if the user wants the column in lets say C of the table it gets generated; same for the row button.
If I added a column in C using the column button and I added a row at line 5 using the row button look at what occurs:
Notice column C how the colors are distorted??
The only time this does not occur is if the user entered values that created rows and columns at the end of the table.
Add Row button code :
Private Sub CommandButton21_Click()
Dim varUserInput As Variant
Dim inpt As String
Dim oLo As ListObject
Dim RowNum
inpt = MsgBox("Do You Want To Add A Row At The END Of The Table?", vbYesNo + vbQuestion, "Add Row Choice") 'user input
If inpt = vbNo Then
' add row to table 'runs if condition is user selected no
varUserInput = InputBox("Enter The Row Number You Want To Generate:", _
"What Row?")
If varUserInput = "" Then Exit Sub
RowNum = varUserInput 'adds row based on user input
Rows(RowNum & ":" & RowNum).Insert shift:=xlDown
Rows(RowNum - 1 & ":" & RowNum - 1).Copy Range("A" & RowNum)
Range(RowNum & ":" & RowNum).ClearContents
Else
Set oLo = ActiveSheet.ListObjects(1) 'first table on sheet
With oLo
.ListRows.Add AlwaysInsert:=True 'adds row to end of table
.Range.Rows(.Range.Rows.Count).RowHeight = 30
End With
End If
End Sub
Add Column button:
Private Sub CommandButton22_Click()
' add column to table
Dim userinput As String
Dim QuestionToMessageBox As String
Dim colIndex As Variant
Dim StrtRow As Long, EndRow As Long, i As Long
Dim oLo As ListObject
userinput = MsgBox("Do you want to add the column at the END of the table?", vbYesNo + vbQuestion, "Add Column Choice") 'user input
If userinput = vbNo Then 'condition if no is selected
On Error GoTo Canceled '
colIndex = Application.InputBox("Enter a column that you want to add: ", "What column?")
If colIndex = "" Then Exit Sub
With ThisWorkbook.Sheets("Sheet1")
.Columns(colIndex).Insert shift:=xlRight '<--| reference column you want to insert
'sheet row numbers from table rows
Set oLo = .ListObjects(1) '<~~ first table on sheet
With oLo
StrtRow = .ListRows(1).Range.Row
EndRow = .ListRows.Count + StrtRow - 1
End With
For i = StrtRow To EndRow
.Cells(i, colIndex).Interior.Color = .Cells(i, 1).DisplayFormat.Interior.Color
Next i
End With
Else 'condition if yes is selected
Set oLo = ActiveSheet.ListObjects(1) 'first table on sheet
With oLo
.ListColumns.Add
.ListColumns(.ListColumns.Count).Range.ColumnWidth = 25
End With
'macro loops through to end of table to generate the proper around column lines
Range("Table1[[#Headers],[Stages]]").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(0, 1).Activate
Loop
ActiveCell.Offset(0, -1).Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End If
Canceled:
End Sub

Answer 1

Because you're dealing with a ListObject the formatting should just work, so I removed all the code that was supposed to format the table. I may have missed something and you'll need to add it back.
You had an On Error Goto Cancelled statement at the beginning of your column procedure which was basically an On Error Exit Sub statement. Unless you were very clear on what errors you expected your code could quit at any error with unexpected or misunderstood results.
Below is my attempt to simplify both routines. I moved things around a lot to try to avoid repetition, got rid of some Variant variables and made other changes.
I also changed the InputBox to an Application.InputBox, which allows you to specify the input type. This means that a blank response will throw up a confusing message to the user, though, so I put Application.DisplayAlerts around the InputBox prompt to suppress the message.
I hope this works as is, I expect that something will be off from what you want. Hopefully though it will get you partway there and show you some new tricks!
Private Sub CommandButton21_Click()
'add row to table
Dim InputPosition As Long
Dim InputEndOfTable As VbMsgBoxResult
Dim oLo As ListObject
Set oLo = ActiveSheet.ListObjects(1) '
With oLo
InputEndOfTable = MsgBox("Do You Want To Add A Row At The END Of The Table?", vbYesNo + vbQuestion, "Add Row Choice")
If InputEndOfTable = vbNo Then
Application.DisplayAlerts = False
InputPosition = Application.InputBox(Prompt:="Enter The Row Number You Want To Add:", Title:="What Row?", Type:=1)
Application.DisplayAlerts = True
Else
InputPosition = .Range.Rows.Count + 1
End If
If InputPosition = 0 Then Exit Sub
If InputEndOfTable = vbYes Then
.ListRows.Add
Else
.ListRows.Add InputPosition
End If
.Range.Rows(InputPosition).RowHeight = 30
End With
End Sub
Private Sub CommandButton22_Click()
'add column to table
Dim InputPosition As Long
Dim InputEndOfTable As VbMsgBoxResult
Dim oLo As ListObject
Set oLo = ActiveSheet.ListObjects(1) '
With oLo
InputEndOfTable = MsgBox("Do You Want To Add A Column At The END Of The Table?", vbYesNo + vbQuestion, "Add column Choice")
If InputEndOfTable = vbNo Then
Application.DisplayAlerts = False
InputPosition = Application.InputBox(Prompt:="Enter The Column Number You Want To Add:", Title:="What Column?", Type:=1)
Application.DisplayAlerts = True
Else
InputPosition = .Range.Columns.Count + 1
End If
If InputPosition = 0 Then Exit Sub
If InputEndOfTable = vbYes Then
.ListColumns.Add
Else
.ListColumns.Add InputPosition
End If
.ListColumns(InputPosition).Range.ColumnWidth = 25
End With
End Sub