Hiding Reference Errors using Font colour in VBA - vba

Hi there i have this code which changes cells with reference errors to white fonts. However i could only do so for a single sheet. range. How do i change the for each loop to loop for all the worksheets in the workbook? I used this code below but it does not seem to work!
Sub Delete_ref_basedontextcondition()
Dim R As Range
'Set rng = Nothing
On Error Resume Next
Set R = Application.InputBox("Select cells To be deleted", Type:=8)
Dim rng As Range
If TypeName(R) <> "Range" Then
Exit Sub
Else
R.Delete
End If
For k = 1 To ThisWorkbook.Worksheets.Count 'runs through all worksheets
Set wks = ThisWorkbook.Worksheets(k)
For Each cell In wks
If cell.Text = "#REF!" Then
cell.Font.Color = RGB(255, 255, 255)
End If
Next
Next
End Sub

While I disagree with your method of hiding #REF! errors rather than dealing with them so that they are not #REF! errors (or deleting the formulas that are creating them, here is some standard 'loop-through-the-worksheets' code that you should be able to adapt for your purposes.
Sub bad_ref()
Dim w As Long, ref As Range
On Error Resume Next
For w = 1 To Worksheets.Count
With Worksheets(w)
For Each ref In .Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
If ref.Text = "#REF!" Then
ref.Font.ColorIndex = 2
'ref.clear '<~~this clears formatting, formulas. etc from the rogue cell.
End If
Next ref
End With
Next w
End Sub
It should run through quickly enough. Rather than examine every cell on each worksheet, I've narrowed down the cells to be critiqued with the Range.SpecialCells method, looking only through the formulas that produce errors. Something like a #N/A error will be left alone.
I've left an option to actually do something with the errors as a commented line.

Related

Errors trying to remove a range a cells in VBA

I've created a small code to remove a range of cells from 2 separate worksheets and Worksheets that are starting with letter N, but always my code is giving me errors or Excel is crashing. The first and second line of code with ClearContents method is giving me those errors.
My code:
'clearing ranges
ThisWorkbook.Worksheets("Sheet1").range("A4", range("AY4").End(xlDown)).ClearContents
ThisWorkbook.Worksheets("Sheet2").range("A3", range("AK3").End(xlDown)).ClearContents
'deleting sheets
For Each sh In ThisWorkbook.Worksheets
If Left(sh.Name, 1) = "N" Then
ThisWorkbook.Worksheets(sh.Name).Delete
End If
Next sh
Thanks for the help!
edit to add some code for the ClearContents issue
ClearContents issue
you wrote
I want to delete the range from A4 until the right down corner of AY4
now it's up to what is to be intended as the "right down corner of AY4"
should it be the last non empty value on column AY then use:
With ThisWorkbook.Worksheets("Sheet001")
.Range("A4", .Cells(.Rows.Count, "AY").End(xlUp)).ClearContents
End With
you may need some more code to handle the case the first non empty cell in column "AY" is above row 4
Sheet Deletion
you may want to try the "Array" approach to exploit an array flavour of the Item property of Worksheets collection and have a one-shot sheets deletion:
Option Explicit
Sub ws()
Dim sh As Worksheet
Dim shtsToDelete As String
With ThisWorkbook
For Each sh In .Worksheets
If Left(sh.name, 1) = "N" Then shtsToDelete = shtsToDelete & sh.name & "\" '<-_| store sht names in a string delimiting them with an invalid character for sheet names
Next sh
If shtsToDelete <> "" Then '<--| if any sheet to be deleted has been found
Application.DisplayAlerts = False '<--| disable alerts to prevent popping out of msgbox prompting you to confirm sheets deletion
.Worksheets(Split(Left(shtsToDelete, Len(shtsToDelete) - 1), "\")).Delete '<--| delete list-sheets in one shot
Application.DisplayAlerts = True '<--| enable alerts back
End If
End With
End Sub
The error appears because you are not allowed to delete objects inside of the current for each loop. Try using a for loop, like this:
For i = ThisWorkbook.Worksheets.Count to 1 Step -1
If Left(ThisWorkbook.Worksheets(i).name, 1) = "N" Then
ThisWorkbook.Worksheets(i).Delete
End If
Next i
your Range definition is wrong, in the inner Range method call, you don't access the range of a specific sheet, so it uses Range of the default sheet. Second problem: If you delete something in a collection, you should loop backwards over the collection because otherwise the Delete operation leads index changes during the loop.
Dim wsheet1 As Worksheet
Dim wsheet2 As Worksheet
Set wsheet1 = ThisWorkbook.Worksheets("Sheet1")
Set wsheet2 = ThisWorkbook.Worksheets("Sheet2")
wsheet1.Columns("A:AY").ClearContents
wsheet2.Columns("A:AK").ClearContents
For i = ThisWorkbook.Worksheets.Count To 1 Step -1
If Left(ThisWorkbook.Worksheets(i).Name, 1) = "N" Then
ThisWorkbook.Worksheets(i).Delete
End If
Next i

Excel VBA - Capitalizing all selected cells in a column with formulas

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

Prevent sub from running

In sheet1 (which I've Called "MainSheet") I have a sub in my VBA script that check the values of some cells whenever a cell is changed in this sheet. (one of the main actions that will occur when a cell is changed is modifying it's color, green for Cell's with a value, red for empty cells)
But now I've got some other sub's that also change cells (in the main sheet) but in this case I don't need (and don't want) VBA to check the cells and adapt the color to their values after every cell change. (annoying when editing a large amount of cells).
(I've already tried to put this sub in the "ThisWorkbook"part of VBA instead of the Sheet1(MainSheet) part, but unfortunately this made no difference at all).
Question one: is it possible to prevent this?
I also have a correlated problem with another sub that worth mentioning in the same question I think: In this sub a new sheet is created, named and filled with text from a .txt document. Then the sheet will be saved as new workbook, and the sheet will be deleted. (The name of the sheet equals the name it will get when it's saved, and varies ever new occurrence.)
When I'm copying the .txt lines into this sheet one by one, the first sub I mentioned (the one editing cell color) is called. one of the first things happening in this sub is calling my MainSheet. When thin sub is finished the line copying sub will continue but will start pasting the lines in my Main Sheet. I tried to enter lines in this sub that select the sheet with variable name, but it keeps jumping to the MainSheet.
Question two: How do I prevent jumping to the MainSheet?
(Both questions probably could have the same solution.)
The sub that modifies the cell colours:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim j As Integer
'Collor all cells green containing values, collor empty cells red.
''Starts automaticly after every cell change within this sheet
'Huidige Cell onthouden
If Not Intersect(Target, Range("A9:A29")) Is Nothing Then
On Error GoTo bm_Safe_Exit3
Application.EnableEvents = False
If Intersect(Target, Range("A9:A29")).Cells.Count > 1 Then
Application.Undo
MsgBox "Please edit one cell at a time!"
Else
Dim newVal3 As Variant
newVal3 = Target.Value
Range("A9:A29").ClearContents
Target.Value = newVal3
End If
End If
bm_Safe_Exit3:
Application.EnableEvents = True
Set myActiveCell = ActiveCell
Set myActiveWorksheet = ActiveSheet
Set myActiveWorkbook = ActiveWorkbook
Sheets("MainSheet").Select
Range("C5").Select
j = 0
Do While j < 6
If ActiveCell.Offset(0, j).Value = "" Then
ActiveCell.Offset(-1, j).Interior.Color = RGB(255, 0, 0)
Else: ActiveCell.Offset(-1, j).Interior.Color = RGB(0, 255, 0)
End If
j = j + 1
Loop
'Terug naar de voormalig active cell
myActiveWorkbook.Activate
myActiveWorksheet.Activate
myActiveCell.Activate
End Sub
Using .Select and .Activate is inefficient at the best of times; in a Worksheet_Change event macro it can really foul the waters.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
If Not Intersect(Target, Range("A9:A29")) Is Nothing Then
If Intersect(Target, Range("A9:A29")).Cells.Count > 1 Then
Application.Undo
MsgBox "Please edit one cell at a time!"
'intentionally throw an error; no more code run; sent to bm_Safe_Exit
Err.Raise 0
Else
Dim newVal3 As Variant
newVal3 = Intersect(Target, Range("A9:A29")).Cells(1).Value
Range("A9:A29").ClearContents
Intersect(Target, Range("A9:A29")).Cells(1) = newVal3
End If
End If
Dim j As Integer
With Worksheets("MainSheet").Range("C5")
For j = 0 To 6
If Not CBool(Len(.Offset(0, j).Value)) Then
.Offset(-1, j).Interior.Color = RGB(255, 0, 0)
Else
.Offset(-1, j).Interior.Color = RGB(0, 255, 0)
End If
Next j
End With
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
It isn't clear exactly what worksheet this is running under; I hope it isn't the MainSheet as I've used direct referencing to the cells on that worksheet.
See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.

How to loop through range names and hide rows if cell = 0?

I have several VBA routines in an Excel 2007. There is a template worksheet which gets copied (and accordingly altered) up to 50 times. Now, this template contains a range called "HideRows", so this range gets copied several times in all those new worksheets. I want to hide all rows that contain the value 0 in the range "HideRows". Not all rows shall be hidden, only those rows that contain the value 0. This is what I've got so far:
Option Explicit
Sub HideEmptyRows()
Dim rngName As Range
Dim cell As Range
Application.ScreenUpdating = False
For Each rngName In ActiveWorkbook.Names
If rngName.Name = "HideRows" Then
With cell
For Each cell In rngName
If .Value = 0 Then
.EntireRow.Hidden = True
End If
Next cell
End With
End If
Next rngName
What's wrong here and what do I need to do to get it to work?
You can address the named range directly without looping. There is no test that this named range exists, as per your description it is safe to assume so.
Secondly, do not use the "with" statement outside of the loop that sets the referenced variable. Try this instead:
Option Explicit
Sub HideEmptyRows()
Dim rngName As Range
Dim cell As Range
Application.ScreenUpdating = False
For Each cell In range("HideRows")
If cell.Value = 0 Then
cell.EntireRow.Hidden = True
End If
Next cell
Application.ScreenUpdating = True
edit:
If the workbook contains multiple identical sheets where each sheet may contain this named range you will have to loop. This code will not loop over all names but over all sheets, and test for existance of the named range in each sheet:
Sub HideEmptyRows()
Dim sh As Sheets
Dim rng As Range, cell As Range
For Each sh In ActiveWorkbook.Sheets
Set rng = Nothing ' this is crucial!
On Error Resume Next
Set rng = sh.Names("HideRows")
On Error GoTo 0
If Not rng Is Nothing Then
For Each cell In rng
cell.EntireRow.Hidden = (cell.Value = 0)
Next cell
End If
Next sh
End Sub
The range variable has to be reset explicitly before the assignment as this step is skipped if the range does not exist. The following If would use the value last assigned then, which would be wrong.

Nested loop does not run properly

I have a nested loop which first changes all ref cells to white font using a for loop and in a sub for loop the ref cells are deleted. The code runs but has still one or two cells with reference errors. Would need help to sort out the code so that it can remove all reference errors instead of most of it! Thank you .
Sub Delete_ref_basedontextcondition()
Dim R As Range
Dim w As Long, ref As Range
Dim refi As Range
On Error Resume Next
'Set rng = Nothing
On Error Resume Next
Set R = Application.InputBox("Select cells To be deleted", Type:=8)
Dim rng As Range
If TypeName(R) <> "Range" Then
Exit Sub
Else
R.Delete
End If
For w = 1 To Worksheets.Count
With Worksheets(w)
For Each ref In .Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
If ref.Text = "#REF!" Then
ref.Font.ColorIndex = 2
For Each refi In .Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
If refi.Text = "#REF!" Then
refi.Delete
End If
Next refi
End If
Next ref
End With
Next w
End Sub
I'm believe that the rogue #REF! is actually created by refi.Delete so it is missed by the loop that was defined prior to its creation. Use refi.Clear instead. You just want to remove the bad formula; you do not want to delete the cell and shift other cells around it (thereby creating new #REF! errors).
Think of it as a Pez dispenser full of #REF! errors. Every time you pop one out, another comes in to take its place. Close the lid with .Clear instead of spiralling through popping them out with .Delete.