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

Microsoft ApplicationsProgrammingVB ScriptMicrosoft OfficeVBA

Last Comment

Escanaba

8/22/2022 - Mon

Rgonzo1971

10/27/2017

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