This macro worked in Excel 2013, but now that I have updated to 2016 it is no longer working. It is meant to lock cells across multiple worksheets in a workbook if they have been filled in.
Private Sub Workbook_BeforeSave()
'Resume to next line if any error occurs
On Error Resume Next
Dim WS_Count As Integer
Dim I As Integer
Dim Cell As Range
'Set WS_Count equal to the number of worksheets in the active workbook.
WS_Count = ActiveWorkbook.Worksheets.Count
'loop through all of the Worksheets
For I = 1 To WS_Count
With ActiveWorkbook.Worksheets(I)
'first of all unprotect the entire sheet and unlock all cells
.Unprotect Password:="open"
.Cells.Locked = False
'Now search for non blank cells and lock them
'unlock blank cells
For Each Cell In ActiveWorkbook.Worksheets(I).UsedRange
If Cell.Value > "" Then
Cell.Locked = True
Else
Cell.Locked = False
End If
Next Cell
'Now protect the entire sheet
.Protect Password:="open"
End With
Next I
Exit Sub
End Sub
When On Error Resume Next is removed it is erroring out on Cell.Locked = True.
In Excel 2016, the workbook_BeforeSave method requires additional, non-optional parameters
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
You need to include these in your method's declaration, even if your code ignores them.
I solved the issue Noob Mistake I had the macro in the module rather than the workbook.
Related
I have tried following VBA code, where I want to run this code for all available worksheets in active workbook, I think I am making small mistake and as I am beginner I am not able to find it out, please help to fix it up
Sub ProtectFormulas()
Dim strPassword As String
Dim ws As Worksheet
For Each ws In Sheets
ws.Activate
.Unprotect
.Cells.Locked = False
.Cells.SpecialCells(xlCellTypeFormulas).Locked = True
.Cells.SpecialCells(xlCellTypeFormulas).FormulaHidden = True
.Protect AllowDeletingRows:=True
strPassword = 123456
ActiveSheet.Protect Password:=strPassword
Next ws
End With
End Sub
Any help would be appriciated by word of thanks.
There are 3 issues with your code:
There is no With block.
The following 2 lines will error if there is no formula in one of the sheets:
.Cells.SpecialCells(xlCellTypeFormulas).Locked = True
.Cells.SpecialCells(xlCellTypeFormulas).FormulaHidden = True
Because if there is no formula then .Cells.SpecialCells(xlCellTypeFormulas) is Nothing and therefore nothing has no .Locked and no .FormulaHidden methods.
You mix using Sheets and Worksheets. Note that those are not the same!
Sheets is a collection of all type of sheets (worksheets, chart sheets, etc)
Worksheets is a collection of only type worksheet
If you declare Dim ws As Worksheet and there is for example a chart sheet in your file, then For Each ws In Sheets will error because you try to push a chart sheet into a variable ws that is defined as Worksheet and cannot contain a chart sheet. Be as specific as possible and use Worksheets whenever possible in favour of Sheets.
The following should work:
Option Explicit
'if this is not variable make it a constant and global so you can use it in any procedure
Const strPassword As String = "123456"
Sub ProtectFormulas()
'Dim strPassword As String
'strPassword = "123456" 'remove this here if you made it global
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
With ws
.Activate 'I think this is not needed
.Unprotect Password:=strPassword 'unprotect probably needs your password too or this will not work once the worksheet was protected.
.Cells.Locked = False
Dim FormulaCells As Range
Set FormulaCells = Nothing 'initialize (because we are in a loop!)
On Error Resume Next 'hide error messages (next line throws an error if no forumla is on the worksheet
Set FormulaCells = .Cells.SpecialCells(xlCellTypeFormulas)
On Error Goto 0 ' re-enable error reporting! Otherwise you won't see errors if they occur!
If Not FormulaCells Is Nothing Then 'check if there were formulas to prevent errors if not
FormulaCells.Locked = True
FormulaCells.FormulaHidden = True
End If
.Protect AllowDeletingRows:=True, Password:=strPassword
End With
Next ws
End Sub
I am using an excel Workbook for programtical generation. Once the workbook is created few of the sheets are having required data and few are blank with default templates only.
I need to delete all sheets having default templates (means no data). I can check specific cell to identify this however need to know how to check for all sheets and then delete sheets one by one.
I am having this piece of code:
Sub TestCellA1()
'Test if the value is cell D22 is blank/empty
If IsEmpty(Range("D22").Value) = True Then
MsgBox "Cell A1 is empty"
End If
End Sub
Try this:
Sub DeleteEmptySheets()
Dim i As Long, ws As Worksheet
' we don't want alerts about confirmation of deleting of worksheet
Application.DisplayAlerts = False
For i = Worksheets.Count To 1 Step -1
Set ws = Worksheets(i)
' check if cell D22 is empty
If IsEmpty(ws.Range("D22")) Then
Sheets(i).Delete
End If
Next
' turn alerts back on
Application.DisplayAlerts = True
End Sub
An alternative implementation using For-Each:
Sub deleteSheets()
Dim wb As Workbook
Dim sht As Worksheet
Set wb = Workbooks("Name of your Workbook")
'Set wb = ThisWorkbook You can use this if the code is in the workbook you want to work with
Application.DisplayAlerts = False 'skip the warning message, the sheets will be deleted without confirmation by the user.
For Each sht In wb.Worksheets
If IsEmpty(sht.Range("D22")) And wb.Worksheets.Count > 1 then
sht.Delete
End If
Next sht
Application.DisplayAlerts = True
End Sub
This mainly serves as a demonstration pf how you can easily loop through worksheets.
As suggested in the comments below by #Darren Bartrup-Cook , the logic according to which the sheets are deleted can and should be modified to not only suit your purposes but to also include safeguards.
Making sure there's always at least one worksheet in the workbook is one of them. This can be ensured in a multitude of ways. I updated my answer to implement one these.
I have a macro that needs to unlock all the sheets in a workbook, run the spell checker, and lock all the sheets (with the original column/cell formatting allowed). The locking errors out each time and I can't figure out why.
I know this doesn't include the formatting aspect, but here's what I've got.
Sub SpellChecker()
'unprotect all sheets
For i = 1 To Sheets.Count
Sheets(i).Unprotect "Password"
Next i
'select all sheets
Dim ws As Worksheet
For Each ws In Sheets
If ws.Visible Then ws.Select (False)
Next
'run spellchecker
Application.CommandBars.FindControl(ID:=2).Execute
'protect sheets
For i = 1 To Sheets.Count
Sheets(i).Protect "Password"
Next i
'selects one sheet/deselect all
Sheets("Sheet1").Select
End Sub
At the point of protecting the sheets, you still have all the sheets selected.
Select just one before
Sheets("Sheet1").Select
'protect sheets
For I = 1 To Sheets.Count
Sheets(I).Protect "Password"
Next I
However, perhaps doing them one sheet at a time is an idea..?
Sub SpellChecker()
For Each ws In Sheets
If ws.Visible Then
ws.Unprotect "Password"
ws.Select
Application.CommandBars.FindControl(ID:=2).Execute
ws.Protect "Password"
End If
Next
End Sub
Here is a method that does not require that the Worksheets ever be unprotected - instead, it will change the Protection on Protected Sheets to allow VBA to edit cells (but not allow the User to edit them) - however, this requires Range.CheckSpelling instead of Application.CommandBars.FindControl(ID:=2).Execute
Sub CheckAllSpelling()
Dim CheckSheet As Worksheet, CheckRange As Range, CheckCell As Range, SheetVisible AS XlSheetVisibility
'Loop through Worksheets in the Workbook
For Each CheckSheet In ThisWorkbook.Worksheets
'Allow VBA to edit a Protected Sheet, but not the User
If CheckSheet.ProtectContents Then CheckSheet.Protect Password:="Password", UserInterfaceOnly:=True
'Filter for Cells with Text to check
On Error Resume Next
Set CheckRange = CheckSheet.UsedRange.SpecialCells(xlCellTypeConstants, xlTextValues)
On Error GoTo 0
'If there are Cells to Check
If Not CheckRange Is Nothing Then
SheetVisible = CheckSheet.Visible
'Loop through cells
For Each CheckCell In CheckRange.Cells
With CheckCell
'If there is a typo, show the cell and Spellcheck it
If Not Application.CheckSpelling(.Text) Then
CheckSheet.Visible= xlSheetVisible
CheckSheet.Activate
.Select
.Show
DoEvents
'This next line is to fix a bug when checking a single cell
CheckSheet.Range(.MergeArea.Address & ", " & .MergeArea.Address) _
.CheckSpelling
End If
End With
Next CheckCell
CheckSheet.Visible= SheetVisible
End If
'Tidy up the Loop
Set CheckRange = Nothing
Next CheckSheet
'Same message as normal Spellcheck
MsgBox "Spell check complete. You're good to go!", vbExclamation
End Sub
(Note the fix for a bug where checking a Single Cell will instead check the entire Sheet)
I have a CommandButton which opens a UserForm and create a copied Sheet with the name of the ComboBox Value.
This is My Code:
Private Sub CommandButton1_Click()
[UserForm1].Show ' Open UserForm
End Sub
Private Sub CommandButton2_Click()
Dim ws As Worksheet
ActiveWorkbook.Sheets("Sheet1").Visible = True ' Unhide Sheet
Sheets("Sheet1").Copy _
Before:=ActiveWorkbook.Sheets("Sheet1") ' Copy Sheet
Set ws = ActiveSheet
ws.Name = ComboBox1.Value ' Name Sheet
[UserForm1].Hide ' Close UserForm
ActiveWorkbook.Sheets("Sheet1").Visible = False ' Hide Sheet again
End sub
Now my problem is, if there are two machines with name "Machine Type 1" Excel gets an Error. So what do i have to change in my code, that the second sheet would named e.g. "Machine Type 1 (2)?
Thanks for your help.
you could try this
Private Sub CommandButton1_Click()
If IsSheetThere(ComboBox1.Value) Then 'if some sheet with chosen name already there
Sheets(ComboBox1.Value).Copy Before:=Sheets(10) ' copy the existing sheet
With ActiveSheet 'reference just copied sheet
.UsedRange.Clear 'clear its content
Sheets("Sheet1").UsedRange.Copy ActiveSheet.Range("A1") ' copy Sheet1 content and paste into it
End With
Else 'otherwise
Sheets("Sheet1").Copy Before:=Sheets(Sheets.Count) ' make a copy of "Sheet1" sheet
ActiveSheet.Name = ComboBox1.Value 'and rename it as per chosen name
End If
Me.Hide
End Sub
Function IsSheetThere(shtName As String) As Boolean
On Error Resume Next
IsSheetThere = Not Sheets(shtName) Is Nothing
End Function
the code line:
Sheets(ComboBox1.Value).Copy Before:=Sheets(10) ' copy the existing sheet
is the one that leaves Excel the burden of somehow "counting" the number of already existing sheets with the chosen name, and name the new one appropriately
You can use the following sub which calls the below function, just apply the same logic using .Copy
Sub create_new_sheet_with_name(name As String, wb As Workbook, aftersheet As Variant)
Dim i As Integer
i = 2
If sheet_name_exists(name, wb) Then
Do While sheet_name_exists(name & " (" & i & ")", wb)
i = i + 1
Loop
wb.Sheets.Add(after:=aftersheet).name = name & " (" & i & ")"
Else
wb.Sheets.Add(after:=aftersheet).name = name
End If
End Sub
Function sheet_name_exists(name As String, wb As Workbook) As Boolean
For Each sheet In wb.Worksheets
If sheet.name = name Then
sheet_name_exists = True
Exit Function
End If
Next sheet
sheet_name_exists = False
End Function
here's an example of how to use the sub:
Sub test()
create_new_sheet_with_name "hi", ThisWorkbook, ThisWorkbook.Sheets(1)
'this adds a new sheet named "hi" to thisworkbook after thisworkbook.sheets(1)
End Sub
Technically this isn't an answer to this question... but it's better because it will help you solve this and many other coding tasks on your own.
There is a simple way to create VBA code for most basic tasks.
If there's something Excel can do that you want to be able to do programmatically, just Record a Macro of yourself performing the action(s), and then look at the code that Excel generated.
I have a terrible memory, I can't remember commands I used yesterday. So it's not only quicker and less frustrating for others for me to figure it out myself, but the more often I do that, the quicker I'll learn (without asking others to do the thinking for me on a basic question).
I fact, I'm guess that the majority of veteran VBA coders learned at least partly by analyzing recorded macros. I know I did.
I have an Excel spreadsheet that needs most of it's cells protected from editing. I can't protect the sheet in the usual way because I work with groups (little + at the top to expand certain columns).
I found a VBA macro to protect my sheet, but noticed in Excel 2010 that I could simply "unprotect sheet" and modify everything, even though the whole workbook is still protected.
This is the macro I use at "ThisWorkbook":
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect Password:="nopassword"
If Range("C3").Value = "protect" Then
Range("C4:C65536").Locked = True
Else
Range("C4:C65536").Locked = False
End If
ActiveSheet.Protect Password:="fakepass"
End Sub
Private Sub Workbook_Open()
Dim x As Long
For x = 1 To ActiveWorkbook.Sheets.Count
With ActiveWorkbook.Sheets(x)
.Protect UserInterfaceOnly:=True
.EnableOutlining = True
End With
Next
End Sub
How can I modify this code to work with Sheet 1?
I'm aware it's not the safest form of protection but it's merely to prevent people modifying cells accidentally.
If you change:
ActiveSheet.Protect Password:="fakepass"
To:
Worksheets("Sheet1").Protect Password:="fakepass"
It will apply to Sheet1 rather than the active sheet only.
Or you could create a macro to protect all sheets, something like:
Sub ProtectAll()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Protect Password:="fakepass", DrawingObjects:=True, Contents:=True, Scenarios:=True
Next ws
End Sub
And then call it into your main code?
ActiveSheet.Unprotect Password:="nopassword" Will only reference whatever sheet you're on.
Sheets("Sheet1").Activate will set active sheet to sheet1, no matter what sheet is selected.
Is that what you were after?