I have a line of code that converts any cells contain #DIV/O error with 0. Which is idealy, apart from when there is no #DIV/o error found in range. When this is that case i get a run time error informing me that there is none found and then I can't move past this.
Is there a way to pass over this issue?
The code goes as follows
Set rng = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
For Each rCell In rng
If rCell.Value = CVErr(xlErrDiv0) Then
rCell.Value = 0
End If
Next
I have tried to play around using NullString & For loops but to no avail.
Any help would be greatful.
One way to overcome the issue is to add ErrorHandler like the one below:
Sub DivByZero()
On Error GoTo ErrHandler:
Dim rng As Range
Set rng = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
For Each rCell In rng
If rCell.Value = CVErr(xlErrDiv0) Then
rCell.Value = 0
End If
Next
ErrHandler:
If Err.Number = 1004 Then
Exit Sub
End If
End Sub
Related
I am running a bit of VBA to switch an entire Excel worksheet to upper case.
However it trips over and gives a Type Mismatch error and fails half way through.
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
I'm assuming it is tripping over a specific cell however there are hundreds of lines. Is there a way to get it to skip errors
If you want to convert all cells to upper case text (including formulas):
Sub MyUpperCase()
Application.ScreenUpdating = False
Dim cell As Range, v As String
For Each cell In Range("$A$1:" & Range("$A$1").SpecialCells(xlLastCell).Address)
v = cell.Text
If Len(v) > 0 Then cell.Value = UCase(v)
Next cell
Application.ScreenUpdating = True
End Sub
Be aware that all formulas not returning Null will also be converted to Text.
To see what cell (or cells) is the problem, you could try:
On Error Resume Next 'to enable in-line error-catching
For Each cell In Range("$A$1:" & Range("$A$1").SpecialCells(xlLastCell).Address)
If Len(cell) > 0 Then cell = UCase(cell)
If Err.Number > 0 Then
Debug.Print cell.Address
Err.Clear
End If
Next cell
On Error GoTo 0 'Turn off On Error Resume Next
On Error Resume Next is often abused, especially by new VBA programmers. Don't turn it on at the beginning of a sub and never turn it off and never check Err.Number. I find it a very good idea to think of it having a specific scope, and emphasizing that scope by indenting the statements in it, as I have done above. #MacroMan raises a good point that errors shouldn't be simply ignored (which is what happens if you abuse this construct).
Add the following error trapping in the middle of your code:
On Error Resume Next
If Len(cell) > 0 Then cell = UCase(cell)
If Err.Number <> 0 Then
MsgBox "Cell " & cell.Address & " has an error !"
End If
On Error GoTo 0
Note: Your code is fine with Numeric values, it's the #NA and #DIV/0 that's raising the errors when running your original code.
This VBA script should take the value in the cell A37 and check if its in the C column of another worksheet. When the number is found the column to the left should be changed to 0. If it is already 0 then a message box will inform the user and if the number does not exist another message box will inform them of this.
This is the VBA I am using to accomplish this. However, every time I try to run it there is a "compile error: Next without For"
Update This issue now is that I need to activate the cell that the fcell is in before doing an Active.cell offset
Sub Cancelled()
Dim x As Long
Dim regRange As Range
Dim fcell As Range
x = ThisWorkbook.Sheets("Welcome").Range("A37").Value
Set regRange = ThisWorkbook.Sheets("Registration").Range("C:C")
For Each fcell In regRange.Cells
If fcell.Value = x Then
ActiveCell.Offset(0, -1).Select
If ActiveCell.Value = 1 Then
ActiveCell.Value = 0
MsgBox "Changed to zero"
Exit Sub
Else
MsgBox "That registration number is already cancelled"
Exit Sub
End If
End If
Next fcell
MsgBox "That number does not exist"
End Sub
Edit for new question: No need to use Select and ActiveCell
If fcell.Value = x Then
If fcell.Offset(0,-1).Value = 1 Then
fcell.Offset(0,-1).Value = 0
...
Edit 2: A further suggestion: You could also use the Range.Find method. This will throw an error if nothing is found so you have to catch that:
On Error Resume Next 'If an error occurs, continue with the next line
Set fcell = regRange.Find(x)
On Error GoTo 0 'disable the error handler
If fcell Is Nothing Then 'If Find failed
MsgBox "That number does not exist"
Else
'do your stuff with fcell here
End If
Hope this is not too late to answer your question:
Sub Cancelled()
Dim x As Long
Dim regRange As Range
Dim fcell As Range
x = ThisWorkbook.Sheets("Welcome").Range("A7").Value
Set regRange = ThisWorkbook.Sheets("Registration").Range("C:C")
For Each fcell In regRange.Cells
If fcell.Value = x Then
If fcell.Offset(0, -1).Value = 1 Then
fcell.Offset(0, -1).Value = 0
MsgBox "Changed to zero"
Else
MsgBox "That registration number is already cancelled"
End If
Exit Sub
End If
Next fcell
MsgBox "That number does not exist"
End Sub
Instead of
Set regRange = ThisWorkbook.Sheets("Registration").Range("C:C")
its better to get the last row in Column C and then set your range as:
Dim lastRow As Long
lastRow = ThisWorkbook.Sheets("Registration").Cells(Rows.Count, "C").End(xlUp).Row
Set regRange = ThisWorkbook.Sheets("Registration").Range("C1:C" & lastRow)
I searched but could not find the way to do this.
I want to know if this is possible
if ActiveDocument.Range.Tables(1).Cell(i, 2) present
do some stuff
end if
This can work:
Dim mycell as cell
On Error Resume Next 'If an error happens after this point, just move on like nothing happened
Set mycell = ActiveDocument.Range.Tables(1).Cell(1, 1) 'try grabbing a cell in the table
On Error GoTo 0 'If an error happens after this point, do the normal Error message thingy
If mycell Is Nothing Then 'check if we have managed to grab anything
MsgBox "no cell"
Else
MsgBox "got cell"
End If
If you want to test for multiple cells in a loop, don't forget to set mycell=nothing before trying again.
(Instead of the mycell variable way, you could also check to see if an error has happened when you tried to use the cell. You could use If err > 0 Then to do that. But that way is a bit more unstable in my experience.)
Specific answer to OP's specific question:
If .Find.Found Then 'this is custom text search, has nothing to do with specified cell exist.
Set testcell = Nothing
On Error Resume Next
Set testcell = tbl.Cell(i, 6)
On Error GoTo 0
If Not testcell Is Nothing Then
tbl.Cell(i, 2).Merge MergeTo:=tbl.Cell(i, 3)
End If
End If
This means:
If your .find does whatever... then
Try grabbing the cell in question (the 4 rows: Set...Nothing, On error..., Set..., On Error...)
If we could grab the cell, then merge cells
Read up a bit on the error handling in VBA, the On Error statement. In VBA, there is no Try...Catch. This is what we can do instead.
I hope this clears it up.
For reference, I'll post a full code here:
Sub test()
Dim tbl As Table
Dim testcell As Cell
Set tbl = ActiveDocument.Range.Tables(1)
For i = 1 To 6
Set testcell = Nothing
On Error Resume Next
Set testcell = tbl.Cell(i, 6)
On Error GoTo 0
If Not testcell Is Nothing Then
tbl.Cell(i, 2).Merge MergeTo:=tbl.Cell(i, 3)
End If
Next i
End Sub
Posting the solution as a function for reference...
Function cellExists(t As table, i As Integer, j As Integer) As Boolean
On Error Resume Next
Dim c As cell
Set c = t.cell(i, j)
On Error GoTo 0
cellExists = Not c Is Nothing
End Function
I'm trying to automatically update the "Updated" column of an excel spreadsheet when any cell of that specific row changes to today's date. I was able to do this by hard-coding where the "Updated" column header would be, however, it is now necessary to search for that column header as it may move.
The code I am trying to implement works but immediately gives me the error Automation error - The object invoked has disconnected from it's clients.
Any help would be appreciated. Here is the code I have currently:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:DX")) Is Nothing Then
Dim f As Range
Set f = ActiveSheet.Range("A1:DD1").Find("Updated", lookat:=xlWhole)
' f.Row = Range(Target).Row
If Not f Is Nothing Then
Range(Split(f.Address, "$")(1) & Target.Row).Value = Now
Else
MsgBox "'Updated' header not found!"
End If
End If
End Sub
You got into an endless loop.
Try this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:DX")) Is Nothing Then
Dim f As Range
Set f = ActiveSheet.Range("A1:DD1").Find("Updated", lookat:=xlWhole)
' f.Row = Range(Target).Row
If f Is Nothing Then
MsgBox "'Updated' header not found!"
ElseIf Intersect(Target, f.EntireColumn) Is Nothing Then
Intersect(Target.EntireRow, f.EntireColumn).Value = Now
' Else
' MsgBox "We entered this function again because the row above updated the Updated column", vbInformation, "False alarm"
End If
End If
End Sub
To understand what happens,
Uncomment the else and MsgBox
Put a breakpoint on the MsgBox
When you hit it, press [ctrl]-L
In a case such as this, I run into far fewer problems when I simply loop through the available cells to find the column header. Using the .Find method also works, but is less "tunable" to my needs in a custom application.
Public Function FindColumn(header As String) As Long
Dim lastCol As Long
Dim headerCol As Long
Dim i As Long
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("VTO2 Labor")
lastCol = sh.Cells(1, sh.Columns.Count).End(xlToLeft).Column
headerCol = 0
For i = 1 To lastCol
If sh.Cells(1, i).Value = header Then
headerCol = i
End If
Next i
FindColumn = headerCol
End Function
It isn't clear on whether the Updated column header could be in row 1 or if it will always be in row 1, just not in the same location.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:DX")) Is Nothing Then
On Error GoTo bm_SafeExit
'TURN OFF EVENTS IF YOU ARE GOING TO WRITE A VALUE INTO THE WORKSHEET!
Application.EnableEvents = False
Dim uCol As Long, f As Range
If Application.CountIf(Rows(1), "updated") Then
uCol = Application.Match("updated", Rows(1), 0)
For Each f In Intersect(Target, Range("A:DX"))
If f.Row > 1 Then _
Cells(f.Row, uCol) = Now
Next f
Else
MsgBox "'Updated' header not found!"
End If
End If
bm_SafeExit:
Application.EnableEvents = True
End Sub
That should survive multiple updates (e.g. when pasting values). The problem I see is that is the Updated column is being shifted around, presumably through inserting columns or the like, then the change routine is going to run.
I'm running the following macro to perform a basic 'FindHighlight' function through a database in MS XL 2003
The find function works perfectly, but the issue I have is that when the 'ClearHighlight' is used (before a search is made) then I get Run-time error 91 - 'Object variable or With block variable not set'
I understand that I need to complete a search before using this function, but others using the tool may not - I was wondering if there is a way to prevent this alert coming up?
(Beginner on VBA!!)
Thank you!
Dim FoundRange As Range
Sub FindHighlight()
Dim tempCell As Range, Found As Range, sTxt As String
sTxt = InputBox("Search string")
If sTxt = "False" Then Exit Sub
Set Found = Range("A1")
Set tempCell = Cells.Find(what:=sTxt, After:=Found, SearchDirection:=xlNext, MatchCase:=False)
If tempCell Is Nothing Then
MsgBox prompt:="Not found", Title:="Finder"
Exit Sub
Else
Set Found = tempCell
Set FoundRange = Found
End If
Do
Set tempCell = Cells.FindNext(After:=Found)
If Found.Row >= tempCell.Row And Found.Column >= tempCell.Column Then Exit Do
Set Found = tempCell
Set FoundRange = Application.Union(FoundRange, Found)
Loop
FoundRange.Interior.ColorIndex = 6
FoundRange.Font.ColorIndex = 3
End Sub
Sub ClearHighlight()
FoundRange.Interior.ColorIndex = xlNone
FoundRange.Font.ColorIndex = xlAutomatic
End Sub
If FoundRange is not set it's value is Nothing so:
Sub ClearHighlight()
if FoundRange is nothing then exit sub
FoundRange.Interior.ColorIndex = xlNone
FoundRange.Font.ColorIndex = xlAutomatic
End Sub