save filtered list with one criteria as workbook and protect part
-
- 4StarLounger
- Posts: 415
- Joined: 29 Mar 2010, 11:50
- Location: Vienna, Austria
save filtered list with one criteria as workbook and protect part
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
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.
-
- Administrator
- Posts: 78587
- 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
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
Hans
-
- 4StarLounger
- Posts: 415
- Joined: 29 Mar 2010, 11:50
- Location: Vienna, Austria
Re: save filtered list with one criteria as workbook and protect part
this is very good.
So, i guess i have to set the partly protection of the Output workbooks and Filter manually?
Thanks,
Stef
So, i guess i have to set the partly protection of the Output workbooks and Filter manually?
Thanks,
Stef
-
- Administrator
- Posts: 78587
- 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
Above the line
insert the following new lines:
Code: Select all
'Save new workbook
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
Hans
-
- 4StarLounger
- Posts: 415
- Joined: 29 Mar 2010, 11:50
- Location: Vienna, Austria
Re: save filtered list with one criteria as workbook and protect part
Thank you so much, Hans, perfect!!!!!
-
- 4StarLounger
- Posts: 415
- Joined: 29 Mar 2010, 11:50
- Location: Vienna, Austria
Re: save filtered list with one criteria as workbook and protect part
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?
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?
-
- Administrator
- Posts: 78587
- 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
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.
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
Hans
-
- 4StarLounger
- Posts: 415
- Joined: 29 Mar 2010, 11:50
- Location: Vienna, Austria
Re: save filtered list with one criteria as workbook and protect part
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
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.
-
- Administrator
- Posts: 78587
- 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
Of course you can sort any way you want BEFORE you protect the worksheet.
Best wishes,
Hans
Hans
-
- 4StarLounger
- Posts: 415
- Joined: 29 Mar 2010, 11:50
- Location: Vienna, Austria
Re: save filtered list with one criteria as workbook and protect part
ok, i adopted the Code so:
It seems fine to work, but it only saves only 11 workfiles of 32 to do
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
Last edited by HansV on 17 Feb 2021, 15:34, edited 1 time in total.
Reason: to add [code] and [/code] tags
Reason: to add [code] and [/code] tags
-
- Administrator
- Posts: 78587
- 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
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?
With the real data, do you see a pattern in the names that are NOT exported?
Best wishes,
Hans
Hans
-
- 4StarLounger
- Posts: 415
- Joined: 29 Mar 2010, 11:50
- Location: Vienna, Austria
Re: save filtered list with one criteria as workbook and protect part
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
Stef
-
- Administrator
- Posts: 78587
- 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
Perhaps OneDrive has become your default file location for Excel?
Best wishes,
Hans
Hans
-
- 4StarLounger
- Posts: 415
- Joined: 29 Mar 2010, 11:50
- Location: Vienna, Austria
Re: save filtered list with one criteria as workbook and protect part
ah, you are right, it must has been changed last night. Strange and no notification….