I have managed to assemble the following code for spell checking a locked document but just cant quit get it to work. I would like it to look at only unlocked cells but still use the 'CommandBars("Tools").Controls("Spelling...").Execute' function. Any ideas would be great. TIA
Sub SelectUnlockedCells_Spellcheck()
ActiveSheet.Unprotect Password:=""
Dim WorkRange As Range
Dim FoundCells As Range
Dim Cell As Range
Set WorkRange = ActiveSheet.UsedRange
For Each Cell In WorkRange
If Cell.Locked = False Then
If FoundCells Is Nothing Then
Set FoundCells = Cell
Else
Set FoundCells = Union(FoundCells, Cell)
End If
End If
Next Cell
If FoundCells Is Nothing Then
MsgBox "All cells are locked."
Else
FoundCells.CheckSpelling CommandBars("Tools").Controls("Spelling...").Execute
End If
ActiveSheet.Protect Password:=""
End Sub
You are using this code
FoundCells.CheckSpelling CommandBars("Tools").Controls("Spelling...").Execute
But the VBA help doesn't show any such parameters. Try using just this:
FoundCells.CheckSpelling
Related
So I'm writing some VBA code that goes through my document and looks for where a formula returns an error and it merges and centers it with the cell that's underneath it.
Private Sub CommandButton22_Click()
Dim strTemp As String
Dim ev As Variant
Dim rng As Range, cell As Range
Set rng = Range("H87:H89")
For Each cell In rng
If (cell.HasFormula) Then
cell.Select
strTemp = ActiveCell.Formula
ev = Evaluate(strTemp)
If (IsError(ev)) Then
ActiveCell.Clear
ActiveCell.Merge ([0,1])
End If
End If
Next cell
End Sub
This is what I have so far, it clears the cell properly but won't merge.
Try using:
Range(Cells(ActiveCell.Row, ActiveCell.Column), Cells(ActiveCell.Row + 1, ActiveCell.Column)).Merge
Hope it helps.
Something like this. Note you rarely need select/activate and should try to avoid it as much as possible.
Private Sub CommandButton22_Click()
Dim cell As Range
For Each cell In Range("H87:H89").Cells
If cell.HasFormula Then
If IsError(cell.Value) Then
cell.Clear
cell.Resize(2, 1).Merge
End If
End If
Next cell
End Sub
I used the code from Siddharth Rout on the following thread to capitalize selected columns but ran into a Error '13' MISMATCH when I used it on a column with cells that had formulas in some of the range.
Excel VBA - Capitalizing all selected cells in column on double click
Here is the code that worked on non-formula based column data from the above link:
Sub ChangeToUpper()
Dim rng As Range
'~~> Check if what the user selected is a valid range
If TypeName(Selection) <> "Range" Then
MsgBox "Select a range first."
Exit Sub
End If
Set rng = Selection
rng = WorksheetFunction.Transpose(Split(UCase(Join( _
WorksheetFunction.Transpose(rng), vbBack)), vbBack))
End Sub
I searched the forums and didn't find specifics related to this. So I googled it and Mr.Excel had this code but still gave the Error '13', when I cleared out of the error message everything was capitalized. Is there a way to eliminate getting this error?
Here is the code from Mr.Excel:
Sub MyUpperCase()
Application.ScreenUpdating = False
Dim cell As Range
For Each cell In Range("$A$1:" & Range("$A$1").SpecialCells(xlLastCell).Address)
If Len(cell) > 0 Then cell = UCase(cell)
Next cell
Application.ScreenUpdating = True
End Sub
Check If Cell has formula and or errors, If yes then ignore.
Sub MyUpperCase()
Application.ScreenUpdating = False
Dim cell As Range
For Each cell In Range("$A$1:" & Range("$A$1").SpecialCells(xlLastCell).Address)
'/ Exclude errors
If Not IsError(cell) Then
If Len(cell) > 0 And Not cell.HasFormula Then
cell = UCase(cell)
End If
End If
Next cell
Application.ScreenUpdating = True
End Sub
My paste link does not seem to work and is giving me a select method of range class failed on the specified line. I don't seem to be able to diagnose this error.
Sub CustomizedInputFixedoutputnotworking()
Dim rng As Range, _
inp As Range, _
ws As Worksheet
Set inp = Selection
On Error Resume Next
Set rng = Application.InputBox("Copy to", Type:=8)
On Error GoTo 0
If TypeName(rng) <> "Range" Then
MsgBox "Cancelled", vbInformation
Exit Sub
Else
Worksheets("Sheet 2").Range("B2:N5").Select ' Code does not work at this line
Worksheets("Sheet 2").Paste Links:=True
End If
Application.CutCopyMode = False
End Sub
Try this code:
Sub CustomizedInputFixedoutputnotworking()
Dim rng As Range, _
inp As Range, _
ws As Worksheet
Set inp = Selection
On Error Resume Next
Set rng = Application.InputBox("Copy to", Type:=8)
On Error GoTo 0
If TypeName(rng) <> "Range" Then
MsgBox "Cancelled", vbInformation
Exit Sub
Else
rng.Copy ' add this line to copy the range that user selected before (with InputBox)
Worksheets("Sheet 2").Activate ' add this line to activate the target worksheet, because select method (the next line) only work in the active sheet
Range("B2:N5").Select
ActiveSheet.Paste Link:=True
End If
Application.CutCopyMode = False
End Sub
NOTE: Copy method will fail if the user select non-contiguous ranges for example A1 and B2, the simple way (not the complete way) to avoid that is by using:
Set rng = Union(rng, rng)
If rng.Areas.Count > 1 Then Exit Sub
I believe your issue is that you selected the text but never copied it to the clipboard. Even if you did copy it, the .Select method would have changed your destination.
I am hopeful a simple change to the .Copy method will resolve your issue. If not, let me know:
Worksheets("Sheet2").Range("B2:N5").Copy
Worksheets("Sheet2").Paste Link:=True
-- edit --
Based on the comment that the selected range is the "copy" (source) and B2:N5 is the destination, try this:
rng.Copy
Worksheets("Sheet2").Range("B2:N5").Select
Worksheets("Sheet2").Paste Link:=True
I am trying to write a macro that will lock any cell greater than 0. When I run the code below it works but locks the 1st row where I have a drop down arrow that does sorting and number filters. Is there a way to add to this code so that the first row wont be locked?
Sub Test()
Dim Cell As Range
Dim MyPlage As Range
With ThisWorkbook.ActiveSheet
.Unprotect
.Cells.Locked = False
Set MyPlage = .Range("J2:AA1074")
For Each Cell In MyPlage
If Not IsError(Cell) Then
If Cell.Value > "0" Then
Cell.Locked = True
End If
End If
Next
.Protect
End With
End Sub
The most simplest was is to define your range which doesn't include the Top Row :)
Change
.Range("J2:AA1074")
to
.Range("J3:AA1074")
Also, Instead of looping through every cell in the range and checking if that cell has an error or not, you can directly use SpecialCells. For example (TRIED AND TESTED)
Sub Sample()
Dim Cell As Range, MyPlage As Range, FinalRange As Range
With ThisWorkbook.ActiveSheet
.Unprotect
.Cells.Locked = False
On Error Resume Next
Set MyPlage = .Range("J3:AA1074").SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If Not MyPlage Is Nothing Then
For Each Cell In MyPlage
If Cell.Value > 0 Then Cell.Locked = True
Next
End If
.Protect DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFiltering:=True, _
AllowSorting:=True
.EnableSelection = xlUnlockedCells
End With
End Sub
To ensure that Autofilter and Sorting works, specify it in .Protect as I have done above.
Before you run the above code, you also need to take one extra step.
Unprotect the worksheet if it is already protected
Under Review Tab, click on "Allow Users to Edit Ranges"
Add "New" range
Select the range you want allow users to sort
Screenshot
You can add following code to the Sheet module (change Range("J1:AA1") to the range with your autofilter):
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.Intersect(Target, Range("J1:AA1")) Is Nothing Then
ActiveSheet.Protect
Else
ActiveSheet.Unprotect
End If
End Sub
I am using the SHEETOFFSET VBA code
Function SHEETOFFSET(offset, Ref)
' Returns cell contents at Ref, in sheet offset
Application.Volatile
With Application.Caller.Parent
SHEETOFFSET = .Parent.Sheets(.Index + offset) _
.Range(Ref.Address).Value
End With
End Function
And then the following code within within my new sheet
=sheetoffset(-1, B2)
to copy the value of cell B2 in the previous sheet to my new sheet.
However, I also need to copy the color of that particular cell. Is there any code that I can enter in the original VBA code above to do this? Or is there another way of achieving this?
Many thanks for your help
Tim
Logic:
Define a Public variable to hold the color of the cell
In Worksheet_Change check if the above variable has any value. If yes then change the color of the target cell.
Once the above is done, reset the variable to 0
Code in Module:
Public cellColor As Double
Function SHEETOFFSET(offset, Ref)
With Application.Caller.Parent
SHEETOFFSET = .Parent.Sheets(.Index + offset) _
.Range(Ref.Address).Value
'~~> Store the color in a variable
cellColor = .Parent.Sheets(.Index + offset) _
.Range(Ref.Address).Interior.ColorIndex
End With
End Function
Code in Sheet Code Area:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim aCell As Range
On Error GoTo Whoa
Application.EnableEvents = False
For Each aCell In Target.Cells
If cellColor <> 0 Then aCell.Interior.ColorIndex = cellColor
Next
Letscontinue:
cellColor = 0
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
ScreenShot:
My Personal Thoughts:
I am not in favor of the SHEETOFFSET function in the first place because the formula is actually referring a cell in the current sheet. Any changes, for example, deletion of that cell will error out your formula
It is better to link the cells directly
FOLLOWUP (From Comments)
You can run this code in the end to refresh all formulas.
Sub Sample()
Dim ws As Worksheet
Dim rng As Range, aCell As Range
For Each ws In ThisWorkbook.Sheets
Set rng = Nothing
On Error Resume Next
Set rng = ws.Cells.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If Not rng Is Nothing Then
For Each aCell In rng
aCell.Formula = aCell.Formula
Next
End If
Next
End Sub