Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to Lock Columns
Hello everyone, usually once a year I get stumped with something in Excel,
I've been in here long enough in the past. LOL. I did something similar to this last year by editing all of the files in a specific folder. But I lost that script, and I'm stumped once again. I want to open over 179 and counting workbooks in a folder, select columns E through K and lock then password protect the file, save and close. I guess this would need to be done. Open the file, Select all cells, format, unlock all cells because at first there could be cells that are locked on some spreadsheets that I dont want lock, then select range E:K, lock, password protect, save and go to the next workbook. Sounds easy right. let me know guys and dolls. this would save so much time. Thanks. Then I have another one I need to do, A macro to select certain files and send it to a specific recepient. I'm pushing my luck right. Regards, |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to Lock Columns
I was writing code similar to what you are requesting, here is some of it,
let me know if you require clarification on anything. Sub load() 'Choose the directory to open the templates from MsgBox "Choose the Templates path", vbOKOnly, "Path" deleteSheets With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False .Show For lngCount = 1 To .SelectedItems.Count strPath = .SelectedItems(lngCount) ShowFileList (strPath) Next lngCount End With 'Open & extract information from each file For Each sht In ThisWorkbook.Sheets If sht.CodeName < "shtCompare" Then Set wb = Workbooks.Open(sht.Range("a1")) 'Cycle through each sht within the newly opened workbook For Each subSht In wb.Sheets 'Cycle through each named range in sheet For Each nm In subSht.Names 'Only named ranges containing the words TABLE or FORMULA are relevant If InStr(1, nm.Name, "TABLE", vbTextCompare) 0 Or _ InStr(1, nm.Name, "FORMULA", vbTextCompare) 0 Then 'Drop this data into it's sheet sht.Range("a3").Offset(lngCounter) = nm.Name sht.Range("b3").Offset(lngCounter) = _ nm.RefersToRange.Rows.Count & "R X " & _ nm.RefersToRange.Columns.Count & "C" sht.Range("c3").Offset(lngCounter) = subSht.Name lngCounter = lngCounter + 1 End If Next Next lngCounter = 0 sht.Range("a:c").Columns.autofit wb.Close False End If Next 'Compare data to Dashboard With Application.FileDialog(msoFileDialogFilePicker) .AllowMultiSelect = False .Show For lngCount = 1 To .SelectedItems.Count strPath = .SelectedItems(lngCount) Next lngCount End With Set wb = Workbooks.Open(strPath) 'Cycle through all sheets and compare named ranges to one's in Dashboard For Each sht In ThisWorkbook.Sheets do until sht.range(" Next End Sub Sub ShowFileList(folderspec) Dim fs, f, f1, fc, s Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(folderspec) Set fc = f.Files Set wb = ThisWorkbook.Sheets For Each f1 In fc Set wks = wb.Add wks.Name = f1.Name wks.Range("a1") = f1.Path wks.Range("a2") = "Named Range" wks.Range("b2") = "Dimensions" wks.Range("c2") = "Sheet Name" With wks.Range("a1:c1") .Merge .HorizontalAlignment = xlCenter .EntireColumn.autofit End With intCounter = intCounter + 1 Next End Sub Sub deleteSheets() Application.DisplayAlerts = False For Each sht In ThisWorkbook.Sheets If sht.CodeName < "shtCompare" Then sht.Delete Next Application.DisplayAlerts = True End Sub -- http://HelpExcel.com 1-888-INGENIO 1-888-464-3646 x0197758 "JavyD" wrote: Hello everyone, usually once a year I get stumped with something in Excel, I've been in here long enough in the past. LOL. I did something similar to this last year by editing all of the files in a specific folder. But I lost that script, and I'm stumped once again. I want to open over 179 and counting workbooks in a folder, select columns E through K and lock then password protect the file, save and close. I guess this would need to be done. Open the file, Select all cells, format, unlock all cells because at first there could be cells that are locked on some spreadsheets that I dont want lock, then select range E:K, lock, password protect, save and go to the next workbook. Sounds easy right. let me know guys and dolls. this would save so much time. Thanks. Then I have another one I need to do, A macro to select certain files and send it to a specific recepient. I'm pushing my luck right. Regards, |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to Lock Columns
That's a pretty intense Macro. I'll look over it. Thanks a million.
"galimi" wrote: I was writing code similar to what you are requesting, here is some of it, let me know if you require clarification on anything. Sub load() 'Choose the directory to open the templates from MsgBox "Choose the Templates path", vbOKOnly, "Path" deleteSheets With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False .Show For lngCount = 1 To .SelectedItems.Count strPath = .SelectedItems(lngCount) ShowFileList (strPath) Next lngCount End With 'Open & extract information from each file For Each sht In ThisWorkbook.Sheets If sht.CodeName < "shtCompare" Then Set wb = Workbooks.Open(sht.Range("a1")) 'Cycle through each sht within the newly opened workbook For Each subSht In wb.Sheets 'Cycle through each named range in sheet For Each nm In subSht.Names 'Only named ranges containing the words TABLE or FORMULA are relevant If InStr(1, nm.Name, "TABLE", vbTextCompare) 0 Or _ InStr(1, nm.Name, "FORMULA", vbTextCompare) 0 Then 'Drop this data into it's sheet sht.Range("a3").Offset(lngCounter) = nm.Name sht.Range("b3").Offset(lngCounter) = _ nm.RefersToRange.Rows.Count & "R X " & _ nm.RefersToRange.Columns.Count & "C" sht.Range("c3").Offset(lngCounter) = subSht.Name lngCounter = lngCounter + 1 End If Next Next lngCounter = 0 sht.Range("a:c").Columns.autofit wb.Close False End If Next 'Compare data to Dashboard With Application.FileDialog(msoFileDialogFilePicker) .AllowMultiSelect = False .Show For lngCount = 1 To .SelectedItems.Count strPath = .SelectedItems(lngCount) Next lngCount End With Set wb = Workbooks.Open(strPath) 'Cycle through all sheets and compare named ranges to one's in Dashboard For Each sht In ThisWorkbook.Sheets do until sht.range(" Next End Sub Sub ShowFileList(folderspec) Dim fs, f, f1, fc, s Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(folderspec) Set fc = f.Files Set wb = ThisWorkbook.Sheets For Each f1 In fc Set wks = wb.Add wks.Name = f1.Name wks.Range("a1") = f1.Path wks.Range("a2") = "Named Range" wks.Range("b2") = "Dimensions" wks.Range("c2") = "Sheet Name" With wks.Range("a1:c1") .Merge .HorizontalAlignment = xlCenter .EntireColumn.autofit End With intCounter = intCounter + 1 Next End Sub Sub deleteSheets() Application.DisplayAlerts = False For Each sht In ThisWorkbook.Sheets If sht.CodeName < "shtCompare" Then sht.Delete Next Application.DisplayAlerts = True End Sub -- http://HelpExcel.com 1-888-INGENIO 1-888-464-3646 x0197758 "JavyD" wrote: Hello everyone, usually once a year I get stumped with something in Excel, I've been in here long enough in the past. LOL. I did something similar to this last year by editing all of the files in a specific folder. But I lost that script, and I'm stumped once again. I want to open over 179 and counting workbooks in a folder, select columns E through K and lock then password protect the file, save and close. I guess this would need to be done. Open the file, Select all cells, format, unlock all cells because at first there could be cells that are locked on some spreadsheets that I dont want lock, then select range E:K, lock, password protect, save and go to the next workbook. Sounds easy right. let me know guys and dolls. this would save so much time. Thanks. Then I have another one I need to do, A macro to select certain files and send it to a specific recepient. I'm pushing my luck right. Regards, |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Lock a row at top for titles of columns? | Excel Discussion (Misc queries) | |||
Can I lock 2 columns together so that the 2 cells in a row are joined? | New Users to Excel | |||
Lock Columns and Hide Formula's | Excel Worksheet Functions | |||
LOCK columns | New Users to Excel | |||
How do I lock hidden columns? | Excel Worksheet Functions |