Hi,
Edit Mod : this thread is related to https://www.excelforum.com/excel-pro...ml#post5267116
I have an excel table in a protected Excel sheet. I should be able to insert row(s) in the table but it is not possible because the sheet is protected therefore I got warning message ("The cell or chart you're trying to change is on a protected sheet. To make a change, unprotect the sheet. You might be requested to enter a password."). I set AllowInsertingRows:=True but it does not help because this an Excel table. Do you know how I can handle this by macro? I tried using the following macro but not working. Can you please help to implement this in the attached table or find another solution?
#Function IsCellInTable(cell As Range) As Boolean
'PURPOSE: Determine if a cell is within an Excel Table
IsCellInTable = False
On Error Resume Next
IsCellInTable = (cell.ListObject.Name <> "")
On Error GoTo 0
End Function
Private Sub AddTableRows()
'PURPOSE: Add table row based on user's selection
Dim rng As Range
Dim InsertRows As Long
Dim StartRow As Long
Dim InsideTable As Boolean
Dim RowToBottom As Boolean
Dim ReProtect As Boolean
Dim Password As String
Dim area As Range
'Optimize Code
Application.ScreenUpdating = False
'What is the worksheet password?
Password = "Nemzetisport89"
'Set Range Variable
On Error GoTo InvalidSelection
Set rng = Selection
On Error GoTo 0
'Unprotect Worksheet
With ActiveSheet
If .ProtectContents Or .ProtectDrawingObjects Or .ProtectScenarios Then
On Error GoTo InvalidPassword
.Unprotect Password
ReProtect = True
On Error GoTo 0
End If
End With
'Loop Through each Area in Selection
For Each area In rng.Areas
'Is selected Cell within a table?
InsideTable = IsCellInTable(area.Cells(1, 1))
'Is selected cell 1 row under a table?
RowToBottom = IsCellInTable(area.Cells(1, 1).Offset(-1))
'How Many Rows In Selection?
InsertRows = area.Rows.Count
'Selection Not Within Table?
If Not InsideTable And Not RowToBottom Then GoTo InvalidSelection
'Add Rows To Table
If InsideTable Then
'Which Row in Table is selected?
With area.Cells(1, 1)
x = .Row
y = .ListObject.DataBodyRange.Row
Z = .ListObject.DataBodyRange.Rows.Count
End With
StartRow = Z - ((y + Z - 1) - x)
'Insert rows based on how many rows are currently selected
For x = 1 To InsertRows
area.ListObject.ListRows.Add (StartRow)
Next x
ElseIf RowToBottom Then
For x = 1 To InsertRows
area.Cells(1, 1).Offset(-1).ListObject.ListRows.Add AlwaysInsert:=True
Next x
End If
Next area
'Protect Worksheet
If ReProtect = True Then ActiveSheet.Protect Password
Exit Sub
'ERROR HANDLERS
InvalidSelection:
MsgBox "You must select a cell within or directly below an Excel table"
If ReProtect = True Then ActiveSheet.Protect Password
Exit Sub
InvalidPassword:
MsgBox "Failed to unlock password with the following password: " & Password
Exit Sub
End Sub
Edit Mod : this thread is related to https://www.excelforum.com/excel-pro...ml#post5267116
I have an excel table in a protected Excel sheet. I should be able to insert row(s) in the table but it is not possible because the sheet is protected therefore I got warning message ("The cell or chart you're trying to change is on a protected sheet. To make a change, unprotect the sheet. You might be requested to enter a password."). I set AllowInsertingRows:=True but it does not help because this an Excel table. Do you know how I can handle this by macro? I tried using the following macro but not working. Can you please help to implement this in the attached table or find another solution?
#Function IsCellInTable(cell As Range) As Boolean
'PURPOSE: Determine if a cell is within an Excel Table
IsCellInTable = False
On Error Resume Next
IsCellInTable = (cell.ListObject.Name <> "")
On Error GoTo 0
End Function
Private Sub AddTableRows()
'PURPOSE: Add table row based on user's selection
Dim rng As Range
Dim InsertRows As Long
Dim StartRow As Long
Dim InsideTable As Boolean
Dim RowToBottom As Boolean
Dim ReProtect As Boolean
Dim Password As String
Dim area As Range
'Optimize Code
Application.ScreenUpdating = False
'What is the worksheet password?
Password = "Nemzetisport89"
'Set Range Variable
On Error GoTo InvalidSelection
Set rng = Selection
On Error GoTo 0
'Unprotect Worksheet
With ActiveSheet
If .ProtectContents Or .ProtectDrawingObjects Or .ProtectScenarios Then
On Error GoTo InvalidPassword
.Unprotect Password
ReProtect = True
On Error GoTo 0
End If
End With
'Loop Through each Area in Selection
For Each area In rng.Areas
'Is selected Cell within a table?
InsideTable = IsCellInTable(area.Cells(1, 1))
'Is selected cell 1 row under a table?
RowToBottom = IsCellInTable(area.Cells(1, 1).Offset(-1))
'How Many Rows In Selection?
InsertRows = area.Rows.Count
'Selection Not Within Table?
If Not InsideTable And Not RowToBottom Then GoTo InvalidSelection
'Add Rows To Table
If InsideTable Then
'Which Row in Table is selected?
With area.Cells(1, 1)
x = .Row
y = .ListObject.DataBodyRange.Row
Z = .ListObject.DataBodyRange.Rows.Count
End With
StartRow = Z - ((y + Z - 1) - x)
'Insert rows based on how many rows are currently selected
For x = 1 To InsertRows
area.ListObject.ListRows.Add (StartRow)
Next x
ElseIf RowToBottom Then
For x = 1 To InsertRows
area.Cells(1, 1).Offset(-1).ListObject.ListRows.Add AlwaysInsert:=True
Next x
End If
Next area
'Protect Worksheet
If ReProtect = True Then ActiveSheet.Protect Password
Exit Sub
'ERROR HANDLERS
InvalidSelection:
MsgBox "You must select a cell within or directly below an Excel table"
If ReProtect = True Then ActiveSheet.Protect Password
Exit Sub
InvalidPassword:
MsgBox "Failed to unlock password with the following password: " & Password
Exit Sub
End Sub