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,

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,

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,