Auto expand table in protected worksheet

[roelandwatteeuw]

Hi all

I have a worksheet with a table. When adding a new line in a non-protected sheet, the table expands automatically.

When the file is protected - with rights to add a new line and writing on a new line - the range of the table doesn't change.

e.g.:
I have data in rows 1 to 10 in a protected file --> table range = rows 1 to 10
I want add new data on row 11 --> table range stays 1 to 10

I need this because the formulas from certain columns have to be copied.
And the file has to be protected to prevent changing/deleting the formulas.

Is there a way (in vba) to auto-expand the table?

Thx!

 

[Dendro]

just an option you would need to be selected. I found this

1. Click File, then Options, then select Proofing on the list on the left
2. Click the ‘AutoCorrect Options’ button
3. On the ‘AutoFormat as You Type’ tab, check the box labeled “Include new rows and columns in table“

 

[roelandwatteeuw]

Thank you for your reply

This option is activated. So this isn't the problem.
Maybe it's easier with an specific example.

This is the file:
TinyUpload.com - best file hosting solution, with no limits, totaly free

Yes it's in dutch. But You'll understand most of it. (I hope everythings works in an English version)

So, what needs to be done.
When opening, the file is fully protected.
Some users will be able to enter data with a password = WW1
They have to unlock the file with the gray button 'Beveiliging afhalen' (means Remove Protection).
If they use this button, the file will open all cells, except rows 1-2 and columns L & N. These stay protected.

When entering data on a new row, so under the table (here row 9), the range of the table stays the same.
So the formulas and conditional formatting aren't copied in the new row.

Second problem:
When entering data in the middle of the table, e.g. between rows 5 and 6, Excel gives an error. Some cells are read-only. And that's correct, because columns L & N are locked. Those columns aren't copied to the new row.

I hope it's clear what my problem is.

Is there a solution for these problems? Or a workaround?
Or do I have to unprotect the whole file to make it work 100%? (with the risk formulas get removed)

To exit the file click the red botton (exit without saving) or green (exit and save)

greetz

just an option you would need to be selected. I found this

1. Click File, then Options, then select Proofing on the list on the left
2. Click the ‘AutoCorrect Options’ button
3. On the ‘AutoFormat as You Type’ tab, check the box labeled “Include new rows and columns in table“

 

[Dendro]

Hi,

I speak dutch too, but I'll continue in English in case other people have the same problem and are following this thread.

When I open your file i get an error immediately. "Global error 1040"-> Range("AC1").Value = "" you have to write in what sheet this range can be found. You can use Activesheet, like you used a lot in your macro's, but i would recommend you to use the sheet name: Sheets("GELDENDE VERSIE").Range("AC1").Value = ""

If i look at your macro's they can be cleaned up a bit, which also helps in finding problems. As an example i'll take the following code from your file.

Sub ONTW()
'
' ONTW

Dim PsWrd As String

'Formulier laden om paswoord op te geven
PsWrd = UserForm1.ValueEntered("Geef het paswoord op", "Beveiligd", "", Chr(42))

'Het paswoord vergelijken
'Verkeerd = exit macro, beveilging blijft
paswoord2 = "WW1"
If PsWrd <> paswoord2 Then
    MsgBox "Het opgegeven paswoord is niet correct", vbOKOnly, "Paswoord foutief"
Exit Sub
    
Else
 
Sheets("GELDENDE VERSIE").Unprotect ("WW1")

Sheets("Invoer ONTW").Select
Sheets("Invoer ONTW").Unprotect ("WW1")

Range("A1:A1000").Select
Selection.Copy

Range("I1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("A1").Select

Sheets("Invoer ONTW").Protect ("WW1"), DrawingObjects:=True, Contents:=True, Scenarios:= _
False, AllowSorting:=True, AllowFiltering:=True

Sheets("GELDENDE VERSIE").Select
    
Dim LR As Long

LR = Range("B" & Rows.Count).End(xlUp).Row

Range("W2").Select
Selection.AutoFill Destination:=Range("W2:W" & LR), Type:=xlFillValues

Range("Y2").Select
Selection.AutoFill Destination:=Range("Y2:Y" & LR), Type:=xlFillValues


Dim LaatsteRij As Integer
LaatsteRij = Range("AA1").Value

Dim DataRange1 As Range
Set DataRange1 = Range(Cells(2, 13), Cells(LaatsteRij, 13))
    DataRange1.Select
    Selection.Copy
    
Dim DataRange2 As Range
Set DataRange2 = Range(Cells(2, 24), Cells(LaatsteRij, 24))
    DataRange2.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Application.CutCopyMode = False

Range("Z1").Select
Selection.Copy
Range("M2").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.AutoFill Destination:=Range("M2:M" & LR), Type:=xlFillValues

Range("D1").Select
Range("A1").Select

Antwoord = MsgBox("Wilt u het bestand opnieuw beveiligen?", vbYesNo, "Beveiligen?")

If Antwoord = vbYes Then
Sheets("GELDENDE VERSIE").Select
Cells.Select
Selection.Locked = True
Sheets("GELDENDE VERSIE").Protect ("WW1"), Contents:=True, Scenarios:= _
False, AllowSorting:=True, AllowFiltering:=True
Range("D1").Select
Range("A1").Select

Else
Sheets("GELDENDE VERSIE").Select
Sheets("GELDENDE VERSIE").Unprotect ("WW1")
    Cells.Select
    Selection.Locked = False
    Range("1:2,L:L,N:N").Select
    Selection.Locked = True
    ActiveSheet.Protect ("WW1"), DrawingObjects:=True, Contents:=True, Scenarios:= _
    True, AllowSorting:=True, AllowFiltering:=True, AllowFormattingCells:=True, AllowInsertingRows:=True
    
    Range("D1").Select
    Range("A1").Select
    
End If
End If
End Sub

This could be shortened to something like this altough this probably won't work yet as i don't understand all your references.

Sub ONTW()
'
' ONTW

Dim PsWrd As String
Dim LR As Long
Dim LaatsteRij As Integer
Dim DataRange1 As Range
Dim DataRange2 As Range

'Formulier laden om paswoord op te geven
PsWrd = UserForm1.ValueEntered("Geef het paswoord op", "Beveiligd", "", Chr(42))

'Het paswoord vergelijken
'Verkeerd = exit macro, beveilging blijft
paswoord2 = "WW1"
If PsWrd <> paswoord2 Then
    MsgBox "Het opgegeven paswoord is niet correct", vbOKOnly, "Paswoord foutief"
Exit Sub
    
Else
Sheets("GELDENDE VERSIE").Unprotect ("WW1")
With Sheets("Invoer ONTW")
    .Unprotect ("WW1")
    .Range("A1:A1000").Copy
    .Range("I1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    .Protect ("WW1"), DrawingObjects:=True, Contents:=True, Scenarios:= _
    False, AllowSorting:=True, AllowFiltering:=True
End With

With Sheets("GELDENDE VERSIE")
    LR = .Range("B" & Rows.Count).End(xlUp).Row
    LaatsteRij = .Range("AA1").Value

    .Range("W2").AutoFill Destination:=Range("W2:W" & LR), Type:=xlFillValues
    .Range("Y2").AutoFill Destination:=Range("Y2:Y" & LR), Type:=xlFillValues

    Set DataRange1 = .Range(Cells(2, 13), Cells(LaatsteRij, 13))
    Set DataRange2 = .Range(Cells(2, 24), Cells(LaatsteRij, 24))
    
    DataRange1.Copy
    DataRange2.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    .Range("Z1").Copy
    .Range("M2").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    .Range("M2").AutoFill Destination:=Range("M2:M" & LR), Type:=xlFillValues

    Antwoord = MsgBox("Wilt u het bestand opnieuw beveiligen?", vbYesNo, "Beveiligen?")

    If Antwoord = vbYes Then
        .Cells.Locked = True
        .Protect ("WW1"), Contents:=True, Scenarios:= _
        False, AllowSorting:=True, AllowFiltering:=True
    Else
        .Unprotect ("WW1")
        .Cells.Locked = False
        .Range("1:2,L:L,N:N").Locked = True
        .Protect ("WW1"), DrawingObjects:=True, Contents:=True, Scenarios:= _
        True, AllowSorting:=True, AllowFiltering:=True, AllowFormattingCells:=True, AllowInsertingRows:=True
    
    End If
End With
End If
End Sub

 

[Dendro]

For your question, i suggest you try table().resize Range()

 

[roelandwatteeuw]

Thanks Dendro

I don't get this (global) error but I'll add the sheetname. It's better to make it complete.

Yes, I know, the code is a bit of a mess.
It started simple and added code, and some more, and more... so it's a collection of all codes.
I'm happy if it works, but like you said, it's better to have it arranged to help finding problems.
I'm not an expert, just searching the web for some codes and make them work for my sheets.
So probably a lot of codes are too long and complex for a frequent programmer.

How would you add the code to my file?