Link to home
Start Free TrialLog in
Avatar of Escanaba
EscanabaFlag for United States of America

asked on

VB Macro to Hide Columns in New Workbooks and Format Adjustments


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.
Avatar of Rgonzo1971


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
        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

Avatar of Escanaba


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
Avatar of Shums Faruk
Shums Faruk
Flag of India image

Link to home
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Thank you!