save filtered list with one criteria as workbook and protect part

User avatar
Stefan_Sand
4StarLounger
Posts: 412
Joined: 29 Mar 2010, 11:50
Location: Vienna, Austria

save filtered list with one criteria as workbook and protect part

Post by Stefan_Sand »

Hello,

i want to save parts of a filtered list with one criteria as workbook and protect (only workbook protect, allowing to sort, and edit in a seperate part) one part of the Output table.

I have a macro where i can save the sorted List, corresponding to the responsible BM (Area Manager). Ist very slow, but i guess this is due to the 130000 rows in the original list.

What i want to do now (and where i need your help now) is :

1. I don´t now how to get only the data table into the new workbook (it Always addes a table..., i don´t know , why)
2. I want these sheets to be partly protected (the columns L:O should be editable) -> the table should let the Area Managers use sort, columnFormatting and AutoFilter
3. The Auto Filter should be set at the Output file

Please see my examples (Base and possible Output). Maybe You can help me out with this.

Stef
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: save filtered list with one criteria as workbook and protect part

Post by HansV »

Is this better?

Code: Select all

Sub SaveFilteredList()
    'Specify sheet name in which the data is stored
    Const sht = "DATA Sheet"

    Dim x As Range
    Dim rng As Range
    Dim rng1 As Range
    Dim last As Long
    Dim wshData As Worksheet
    Dim newBook As Workbook
    Dim wshNew As Worksheet

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    ' Worksheet with data
    Set wshData = ThisWorkbook.Worksheets(sht)

    'change filter column in the following code
    last = wshData.Cells(wshData.Rows.Count, "E").End(xlUp).Row

    Set rng = wshData.Range("A1:O" & last)

    wshData.Range("E1:E" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wshData.Range("AA1"), Unique:=True

    ' Loop through unique values in column
    For Each x In wshData.Range([AA2], Cells(wshData.Rows.Count, "AA").End(xlUp))
        With rng
            .AutoFilter
            .AutoFilter Field:=5, Criteria1:=x.Value    'Achtung: hier ist die Spaltennummer gezählt, wonach gefiltert wird, in diesem Fall Spalte 5, also E
            .SpecialCells(xlCellTypeVisible).Copy

            'Add New Workbook in loop
            Set newBook = Workbooks.Add(xlWBATWorksheet)
            Set wshNew = newBook.Worksheets(1)
            wshNew.Name = x.Value
            wshNew.Paste
        End With

        'Save new workbook
        newBook.SaveAs x.Value & ".xlsx"

        'Close workbook
        newBook.Close SaveChanges:=False
    Next x

    Application.CutCopyMode = False

    ' Turn off filter
    wshData.AutoFilterMode = False
    wshData.Columns("A:O").AutoFilter

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub
Best wishes,
Hans

User avatar
Stefan_Sand
4StarLounger
Posts: 412
Joined: 29 Mar 2010, 11:50
Location: Vienna, Austria

Re: save filtered list with one criteria as workbook and protect part

Post by Stefan_Sand »

this is very good.
So, i guess i have to set the partly protection of the Output workbooks and Filter manually?

Thanks,
Stef

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: save filtered list with one criteria as workbook and protect part

Post by HansV »

Above the line

Code: Select all

        'Save new workbook
insert the following new lines:

Code: Select all

        wshNew.Columns("A:O").AutoFilter
        wshNew.Range("L:O").Locked = False
        wshNew.Protect Password:="Stefan", AllowFormattingColumns:=True, AllowSorting:=True, AllowFiltering:=True
Best wishes,
Hans

User avatar
Stefan_Sand
4StarLounger
Posts: 412
Joined: 29 Mar 2010, 11:50
Location: Vienna, Austria

Re: save filtered list with one criteria as workbook and protect part

Post by Stefan_Sand »

Thank you so much, Hans, perfect!!!!!

User avatar
Stefan_Sand
4StarLounger
Posts: 412
Joined: 29 Mar 2010, 11:50
Location: Vienna, Austria

Re: save filtered list with one criteria as workbook and protect part

Post by Stefan_Sand »

Sorry, one last Question i have. How can i sort the data in the Output worksheets afterwards in column J where the money data are?

in the Code there is set:
wshNew.Protect Password:="XYZ", AllowFormattingColumns:=True, AllowSorting:=True, AllowFiltering:=True
but it seems, that they cant sort it on their own, so i think i must forgot something?

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: save filtered list with one criteria as workbook and protect part

Post by HansV »

Only unlocked cells can be sorted.
The table can only be sorted as a whole, but columns A to K are locked.
You'd have to provide a macro that
- Unprotects the worksheet.
- Sorts data.
- Protects the worksheet.
You'd have to save the workbooks as macro-enabled workbooks, and the users would have to allow macros.
Best wishes,
Hans

User avatar
Stefan_Sand
4StarLounger
Posts: 412
Joined: 29 Mar 2010, 11:50
Location: Vienna, Austria

Re: save filtered list with one criteria as workbook and protect part

Post by Stefan_Sand »

so isnt it possible to do this if i first set?
Dim strSpalte As Range

and then adopt the Code, bevore the data are locked in the Code with:

wshNew.Columns("A:O").AutoFilter
wshNew.Columns("J").Sort , Key1:=Range(strSpalte & "1"), Order1:=xlDescending, Header:=xlYes
wshNew.Range("L:O").Locked = False
wshNew.Range("L1:O1").Locked = True
wshNew.Protect Password:="", AllowFormattingColumns:=True, AllowSorting:=True, AllowFiltering:=True
Last edited by Stefan_Sand on 17 Feb 2021, 14:53, edited 1 time in total.

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: save filtered list with one criteria as workbook and protect part

Post by HansV »

Of course you can sort any way you want BEFORE you protect the worksheet.
Best wishes,
Hans

User avatar
Stefan_Sand
4StarLounger
Posts: 412
Joined: 29 Mar 2010, 11:50
Location: Vienna, Austria

Re: save filtered list with one criteria as workbook and protect part

Post by Stefan_Sand »

ok, i adopted the Code so:

Code: Select all

Sub SaveFilteredList()
    'vor dem Ausf?hren mit gro?en Datenmengen, auf manuelle Berechnung in den Optionen umstellen!
    'Specify sheet name in which the data is stored
    ' nicht vergessen, im Code wird auf einen Namen f?r das Filtern der Daten verwiesen,
    'also in neuer Arbeitsmappe bitte in Spalte AA neu anlegen, sonst geht das Makro ins Leere
    
    Const sht = "DATA Sheet"

    Dim x As Range
    Dim rng As Range
    Dim rng1 As Range
    Dim last As Long
    Dim wshData As Worksheet
    Dim newBook As Workbook
    Dim wshNew As Worksheet
    Dim strSpalte As String

    'Klassiker, alle Berechnungen ausschalten
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    ' Worksheet with data 
    Set wshData = ThisWorkbook.Worksheets(sht)
    strSpalte = "J"

    'change filter column in the following code - hier setzt man die zu filternde Spalte
    last = wshData.Cells(wshData.Rows.Count, "E").End(xlUp).Row

    Set rng = wshData.Range("A1:O" & last)

    wshData.Range("E1:E" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wshData.Range("AA1"), Unique:=True

    ' Loop through unique values in column - > Namemanager, Kriterium w?hlen(select filter criteria)
    
    For Each x In wshData.Range([AA2], Cells(wshData.Rows.Count, "AA").End(xlUp))
        With rng
            .AutoFilter
            .AutoFilter Field:=5, Criteria1:=x.Value    'Achtung: hier ist die Spaltennummer gez?hlt, wonach gefiltert wird, in diesem Fall Spalte 5, also E, der OM
            .SpecialCells(xlCellTypeVisible).Copy

            'Add New Workbook in loop
            Set newBook = Workbooks.Add(xlWBATWorksheet)
            Set wshNew = newBook.Worksheets(1)
            wshNew.Name = x.Value
            wshNew.Paste
        End With
    'set filter and protected area in new workbook 
        wshNew.Columns("A:O").AutoFilter
        wshNew.Columns("J:J").Sort , Key1:=Range(strSpalte & "1"), Order1:=xlDescending, Header:=xlYes         'sortiere nach Spalte J  ? descending 
        wshNew.Range("L:O").Locked = False
        wshNew.Range("L1:O1").Locked = True      'new lock a Range
        wshNew.Protect Password:="JAB", AllowFormattingColumns:=True, AllowSorting:=True, AllowFiltering:=True
        
        'Save new workbook
        newBook.SaveAs x.Value & ".xlsx"

        'Close workbook
        newBook.Close SaveChanges:=False
    Next x

    Application.CutCopyMode = False

    'Turn off filter
    wshData.AutoFilterMode = False
    wshData.Columns("A:O").AutoFilter

    'Do not forget: alle Berechnungen wieder einschalten
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub
It seems fine to work, but it only saves only 11 workfiles of 32 to do
Last edited by HansV on 17 Feb 2021, 15:34, edited 1 time in total.
Reason: to add [code] and [/code] tags

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: save filtered list with one criteria as workbook and protect part

Post by HansV »

The workbook that you attached higher up in this thread contains 23 unique names in column E, and the new version of the code produces exactly 23 workbooks.
With the real data, do you see a pattern in the names that are NOT exported?
Best wishes,
Hans

User avatar
Stefan_Sand
4StarLounger
Posts: 412
Joined: 29 Mar 2010, 11:50
Location: Vienna, Austria

Re: save filtered list with one criteria as workbook and protect part

Post by Stefan_Sand »

sorry, Hans, but we are migrating to Azure and i found out what happened. It exactly exports all the files if i deactivate calculation in the options and, surprise for me, i have a filefolder for Excel in our OneDrive and now, it exports all the files there, i don´t know why, but as long, as it works , i am glad and thank You. Sorry for the disturbance.
Stef

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: save filtered list with one criteria as workbook and protect part

Post by HansV »

Perhaps OneDrive has become your default file location for Excel?
Best wishes,
Hans

User avatar
Stefan_Sand
4StarLounger
Posts: 412
Joined: 29 Mar 2010, 11:50
Location: Vienna, Austria

Re: save filtered list with one criteria as workbook and protect part

Post by Stefan_Sand »

ah, you are right, it must has been changed last night. Strange and no notification….