Show comments of certain merged cells in protected mode - excel

I need to show comments in certain merged cells that are unlocked.
I found code online to show all comments in a workbook. This will not work because my workbook needs to be protected, which means the macro will look at locked cells and end prematurely.
Sub Show_Comment()
On Error Resume Next
For Each ws In ActiveWorkbook.Sheets
Set allCommentRng = ws.Cells.SpecialCells(xlCellTypeComments)
For Each Rng In allCommentRng
Rng.Comment.Visible = True
Next
Next
On Error GoTo 0
End Sub
I need to know how to specify a merged range that has a comment. The first merged range is "C7:C8-E7:E8". If I know how to do one range, I will figure our how to do the others.
A picture of what the cell looks like as well as the button:
This not for school.

You must first unprotect worksheet before trying to manipulate it and after changes have been applies, restore protection.
For Each ws In ActiveWorkbook.Sheets
ws.Unprotect
Set allCommentRng = ws.Cells.SpecialCells(xlCellTypeComments)
For Each Rng In allCommentRng
Rng.Comment.Visible = True
Next Rng
ws.Protect
Next ws
Example above implies no password protection. To overcome password protection for worksheets use:
ws.Unprotect Password:="yourpasswordhere"
ws.Protect Password:="yourpasswordhere"

How about if you unprotect the worksheet before you run the macro and re-protect if after:
Sub Show_Comment()
On Error Resume Next
For Each ws In ActiveWorkbook.Sheets
ws.unprotect
Set allCommentRng = ws.Cells.SpecialCells(xlCellTypeComments)
For Each Rng In allCommentRng
Rng.Comment.Visible = True
Next Rng
ws.protect
Next ws
On Error GoTo 0
End Sub

Related

VBA loop through all worksheets in workbook

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

Can't refer the range of selection to any specific sheet

I've created a macro to print the range of cells and it's content in the console. The macro is doing just fine. However, the problem is I can't use a button (in another sheet) conected to that macro. To be clearer - I created a macro-enabled button in sheet2 whereas the range of cells I wanaa select and print are within sheet1.
I've tried so far:
Sub LoopAndPrintSelection()
Dim ocel As Range, RangeSelected As Range
Set RangeSelected = Application.Selection
For Each ocel In RangeSelected.Cells
Debug.Print ocel.Address, ocel.value
Next ocel
End Sub
How can I refer the range of selection to any specific sheet?
As others have already mentioned, the "Application.Selection" property will refer to what you have selected in your active sheet. I would recommend that you assign a hotkey to this macro and then you can select the cells you want to print and use the macro's hotkey.
This is one possible solution, but if you need that button on a different sheet and want people to interact with the button (rather than a hotkey) then this won't solve your issue.
This should help with the issue of two different tabs
Sub DUMMY_TEST()
Dim myAREA As Range
Dim mySELECTION As Range
On Error GoTo error_spot
'Stop Excel from "blinking" as tabs are selected/changed and calculating.
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set mySELECTION = Application.Selection 'Used to get back to same spot after code has executed
If Sheets("Sheet1").Visible = True Then
Sheets("Sheet1").Activate
Else
'tab not visible, end sub
GoTo error_spot
End If
Set myAREA = Application.Selection
For Each ocel In myAREA.Cells
Debug.Print ocel.Address, ocel.Value
Next ocel
mySELECTION.Worksheet.Activate
mySELECTION.Select
error_spot:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Delete multiple Excel Sheets in VBA

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.

Excel Macro - Unlock, Spellcheck, Lock

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)

Copy and paste error

Is there something wrong with my formula? I'm trying to use a formula to bring me to gotoreference(I.e f5) the cell to verify that cells are indeed right before proceeding or either msgbox prompting to proceed or that the workbook/worksheet cannot be found. Also sometimes the person leaves blank because it is quarterly data, I would like it to autoextract latest data (farthest) column.
I've two workbooks: one is my current workbook (Currentworkbook.xlsx) that I'm running the macro on. The other is Jedata.xlsx of 'Mysheettab' and few other workbooks not listed here, will be feeding information into Currentworkbook.xlsx of 'Sheet1'.
Option explicit
Sub Macro3()
' Macro3 Macro
'
' Keyboard Shortcut: Ctrl+q
'
Dim wb As Workbook
Dim ws As Worksheet
On Error Resume Next
Set wb = ActiveWorkbook("Jedata")
Set ws = ActiveWorkbook.Sheets("Mysheettab")
On Error GoTo 0
If ws Is Nothing Then
MsgBox "Data sheet not found"
Else
Activate.Windows ("wb")
Sheets("ws").Select
Application.Goto Reference:=Range("AG28:AG32").Select
Selection.Copy
Windows("Currentworkbook").Activate
Selection.Copy
Range("H10:H14").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
End Sub
I can see lot of errors in your code.
First things first. You avoid the use of .Activate/.Select. INTERESTING READ
Next regarding Activate.Windows ("wb"). Anything between the " will be considered as a string. I think you wanted to try
wb.Activate
But like I mentioned, you should avoid the use of .Activate/.Select. Your code can be written as (UNTESTED)
Sub Macro3()
Dim wb As Workbook, thiswb As Workbook
Dim ws As Worksheet, thisws As Worksheet
On Error GoTo Whoa
Set thiswb = thisowrkbook
Set thisws = thiswb.ActiveSheet
Set wb = Workbooks("Jedata")
Set ws = wb.Sheets("Mysheettab")
ws.Range("AG28:AG32").Copy thisws.Range("H10")
Application.CutCopyMode = False
Exit Sub
Whoa:
MsgBox Err.Description
End Sub

Resources