VB Macro to Hide Columns in New Workbooks and Format Adjustments

Hello,

The attached sample has an existing macro which creates different workbooks based on the data in column C.  I am hoping someone can help add to this code by making the following updates:

1.  For every new workbook created the column width is expanded to 15
2.  For every new workbook created columns B, C, F, G H, I, O, P, T, U, V, X, AE, AJ and AK are hidden and locked.
3.  For every new workbook created the entire workbook is password protected.  Sample password can be:  password.

Any assistance would be greatly appreciated!  I am not very proficient in VB code and hoping some of you Excel/VB ninjas can figure this out.

Thank you.
EE-Sample.xlsm
LVL 1
EscanabaAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rgonzo1971Commented:
Hi,

pls try
Option Explicit

Sub CreateNewWorkbooks()
Dim swb As Workbook, wb As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim lr As Long, i As Long
Dim FilePath As String, FileName As String
Dim x, dict, it

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set swb = ThisWorkbook
Set ws1 = swb.Sheets("Planning Worksheet")
Set ws2 = swb.Sheets("Instructions")
Set ws3 = swb.Sheets("2017 Band")

FilePath = "S:\File\"

ws1.AutoFilterMode = False
lr = ws1.Cells(Rows.Count, 3).End(xlUp).Row

x = ws1.Range("C14:C" & lr)
Set dict = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(x, 1)
    dict.Item(x(i, 1)) = ""
Next i

For Each it In dict.keys
    FileName = it & ".xlsx"
    With ws1.Rows(13)
        .AutoFilter field:=3, Criteria1:=it
        Set wb = Workbooks.Add
        ws1.Range("A1:AN" & lr).SpecialCells(xlCellTypeVisible).Copy wb.Sheets(1).Range("A1")
        wb.Sheets(1).Name = ws1.Name
        wb.Sheets(1).UsedRange.ColumnWidth = 15
        With wb.Sheets(1).Range("B1,C1,E1,F1,G1,H1,I1,O1,P1,T1,U1,V1,X1,AE1,AJ1,AK1").EntireColumn
            .Locked = True
            .Hidden = True
        End With
        wb.Sheets(1).Protect Password:="password"
        ws2.Copy after:=wb.Sheets(Sheets.Count)
        ws3.Copy after:=wb.Sheets(Sheets.Count)

        wb.SaveAs FilePath & FileName, FileFormat:=51
        wb.Close
        Set wb = Nothing
        Application.CutCopyMode = 0
    End With
Next it
ws1.AutoFilterMode = False
Application.ScreenUpdating = True
Application.CutCopyMode = 0
MsgBox dict.Count & " Workbooks have been created and saved in the folder " & FilePath & "!", vbInformation
End Sub

Open in new window

Regards
0
EscanabaAuthor Commented:
Hello - It throws up an error at line 39.  
The error states:  "Run-time error '1004':  Unable to set the Locked property of the Range class
0
ShumsDistinguished Expert - 2017Commented:
Hi,

Try below:
Option Explicit

Sub CreateNewWorkbooks()
Dim swb As Workbook, wb As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim lr As Long, i As Long
Dim FilePath As String, FileName As String
Dim x, dict, it

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set swb = ThisWorkbook
Set ws1 = swb.Sheets("Planning Worksheet")
Set ws2 = swb.Sheets("Instructions")
Set ws3 = swb.Sheets("2017 Band")

FilePath = "S:\File\"

ws1.AutoFilterMode = False
lr = ws1.Cells(Rows.Count, 3).End(xlUp).Row

x = ws1.Range("C14:C" & lr)
Set dict = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(x, 1)
    dict.Item(x(i, 1)) = ""
Next i

For Each it In dict.keys
    FileName = it & ".xlsx"
    With ws1.Rows(13)
        .AutoFilter field:=3, Criteria1:=it
        Set wb = Workbooks.Add
        ws1.Range("A1:AN" & lr).SpecialCells(xlCellTypeVisible).Copy wb.Sheets(1).Range("A1")
        wb.Sheets(1).Name = ws1.Name
        With wb.Sheets(1)
            .UsedRange.ColumnWidth = 15
            .Cells.Locked = False
            .Range("B:C,F:I,O:P,T:V,X:X,AE:AE,AJ:AK").Select
            .Range("F1").Activate
            Selection.Locked = True
            .Range("B:C,F:I,O:P,T:V,X:X,AE:AE,AJ:AK").EntireColumn.Hidden = True
        End With
        ws2.Copy after:=wb.Sheets(Sheets.Count)
        ws3.Copy after:=wb.Sheets(Sheets.Count)
        Application.DisplayAlerts = False
        wb.SaveAs FilePath & FileName, FileFormat:=51, Password:="password"
        wb.Close
        Application.DisplayAlerts = True
        Set wb = Nothing
        Application.CutCopyMode = 0
    End With
Next it
ws1.AutoFilterMode = False
Application.ScreenUpdating = True
Application.CutCopyMode = 0
MsgBox dict.Count & " Workbooks have been created and saved in the folder " & FilePath & "!", vbInformation
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
EscanabaAuthor Commented:
Thank you!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Applications

From novice to tech pro — start learning today.