I am trying to autofilter on any cell with #DIV/0 using the code below however it keeps returning "Some Other Error" even though there are the above errors in column A.
Sub asdf2()
Dim R As Range
Set R = Range("A:A")
If IsError(R.Value) = True Then
If R.Value = CVErr(xlErrDiv0) Then
With R
.AutoFilter field:=1, Criteria1:=R.Value
End With
End If
Else
Debug.Print "Some other error"
End If
End Sub
As R is a multi cell range spanning a whole column, there is no .Value property.
Debug until you executed the Set R = ... statement and then examine the properties of R in the Locals window.
Secondly - interpreting your Else / Debug.Print branch, you are looking only for cells containing any error. Your Else branch will also be executed for cells not containing any error. So your Else branch should be attached to the inner If
Lastly, you cannot provide an error value as an argument for .Autofilter ... use a string Criteria1:="#DIV/0!" instead.
Mocking this all up ...
Sub asdf2()
Dim R As Range, C As Range
Set R = Range("A:A")
For Each C In R.Cells
Debug.Print C.Value
If IsError(C.Value) = True Then
If C.Value = CVErr(xlErrDiv0) Then
With R
.AutoFilter field:=1, Criteria1:="#DIV/0!"
End With
Else
Debug.Print "Other Error"
End If
Exit For
End If
Next C
End Sub
So here
on detecting a #DIV/0! error an autofilter is set
on detecting any other error a debug.print is issued
otherwise nothing happens
in case of 1,2 the loop is terminated immediately - no further checking
Related
I have a table with two data columns. I need to find the line where both of them are a hit. So far this is what my code looks like:
Dim ws As Worksheet
Set ws = Worksheets(1)
Set rgfound = ws.Range("A:A").Find(MyInputOne.value), LookAt:=xlWhole)
If rgfound Is Nothing Then
MsgBox "No results"
Exit Sub
Else
If rgfound.Offset(0, 3).Value <> MyInputTwo.Value Then
Do
Set rgfound = ws.Range("A:A").FindNext(rgfound)
Loop Until rgfound.Offset(0, 3).Value = MyInputTwo.Value
End If
End If
rgfound.Offset(0, 5).Value = "Found!"
This enters an infinite loop and crashes, and I have to force quit excel after running it.
Any advice will be appreciated.
I wouldn't use loops for this kind of thing.
The built in AutoFilter is super quick if you know how to manipulate it in VBA and it will avoid any need for loops/ problems with infinite loops
Here's the code:
Option Explicit
Sub FindBoth()
Dim sht As Worksheet
Dim data As Range, result As Range
Set sht = ThisWorkbook.Worksheets("Sheet1")
Set data = sht.Range("A1:D101")
sht.AutoFilterMode = False 'clear existing filter
With data
.AutoFilter field:=1, Criteria1:=8
.AutoFilter field:=4, Criteria1:="A"
Set result = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Rows(1)
If Not Intersect(result, data) Is Nothing Then
result.Offset(0, 5).Resize(1, 1).Value = "Found!"
End If
End With
sht.AutoFilterMode = False
End Sub
My data looked like this:
Most probably it loops to infinity, because the code never satisfies this condition:
Loop Until rgfound.Offset(0, 3).Value = MyInputTwo.Value
To see what is happening write:
Debug.Print rgfound.Offset(0, 3).Value
Debug.Print MyInputTwo.Value
before the condition above. Another option to check what is happening is to introduce some counter, which would force the code to stop after the 2000. iteration. Like this:
Public Sub TestMe()
Dim cnt As Long
Do
cnt = cnt + 1
Debug.Assert cnt < 2000
Debug.Print cnt
Loop Until False
End Sub
Once it stops because of the fail of the Debug.Assert condition, you would be able to debug manually and to get what is happening.
Definitely the most simplistic answer here, but if you know your parameters and it should never 'Loop' over a certain amount of times, you can try putting a FOR I / NEXT I statement.
Just another idea to throw out there.
I'm having a problem with a "For Each" related to a Range defined by a SpecialCells method. When I run the code below, there is a "Next without For" error, which I believe is because the rRange is empty when I first run the code. I could put "On Error Resume Next" in the beggining of the sub, but I'm trying to avoid this.
Public Sub Sub1()
Set rRange = Worksheets("Combate").Range("69:99").SpecialCells(xlCellTypeConstants, xlNumbers)
If Not rRange Is Nothing Then
For Each c In rRange
If c.Value <= turnoseg Then
c.Offset(-2 * lincomb0 + 6).Value = c.Offset(-lincomb0 + 3).Value
c.Value = ""
Next c
atualizarefeitos6
End If
End Sub
In another sub, I'm having a "No cells were selected" error after I run the code below. I really don't know how to actually solve the errors in these subs, but you guys surely would know.
Sub efeitosaddatac6()
'On Error Resume Next
Set rRange = Worksheets("Combate").Range("69:99").SpecialCells(xlCellTypeConstants, xlNumbers)
For Each c In rRange
c.Value = c.Value + 1
Next c
atualizarefeitos6
End Sub
Thanks in advance.
As pointed out in a comment by John Coleman, your first subroutine isn't working because you are missing an End If. You probably want:
Public Sub Sub1()
Set rRange = Worksheets("Combate").Range("69:99").SpecialCells(xlCellTypeConstants, xlNumbers)
If Not rRange Is Nothing Then
For Each c In rRange
If c.Value <= turnoseg Then
c.Offset(-2 * lincomb0 + 6).Value = c.Offset(-lincomb0 + 3).Value
c.Value = ""
End If
Next c
atualizarefeitos6
End If
End Sub
This is one of the reasons that consistent indentation of code is useful - it highlights missing End Ifs, etc.
I would recommend you change your second subroutine as follows:
Sub efeitosaddatac6()
Set rRange = Nothing
On Error Resume Next
Set rRange = Worksheets("Combate").Range("69:99").SpecialCells(xlCellTypeConstants, xlNumbers)
On Error GoTo 0
If Not rRange Is Nothing Then
For Each c In rRange
c.Value = c.Value + 1
Next c
atualizarefeitos6
End If
End Sub
Also, if you are not already using Option Explicit at the start of your code module, I recommend you do so. (I'm hoping that you are already using it, and that the lack of variable declarations within each subroutine is simply because they have all been declared at the module level.)
Luis Filho,
You need to insert:
End If
before
Next c
Another item you need to define is:
atualizarefeitos6
Is this a variable or function?
Basically, I have a rather large (and growing) sheet of position details and I'm looking to build in a sub routine that, once a position number is entered into the relevant cell, will auto-populate the corresponding cells in the row. VLOOKUP would do the trick nicely except, when a position has multiple lines, it returns the earliest set of details--I need it to return the latest.
I can produce the answer I need using a LOOKUP function , but I can't seem to translate the function across to VBA.
Example lookup function:
LOOKUP(D17,1/($D$2:$D$10=D17),E2:E10)
This is what I have so far
Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Column = 4 Then
actionrow = Target.Row
resulte = Application.WorksheetFunction.Lookup(2, 1 / Range("D2:D10") = Target.Value, Range("E2:E10"))
If Target.Value <> "" Then
Range("E" & actionrow).formula = resulte
End If
End If
End Sub
I think that looking at column D for a matching value with the Range.Find method would do. Start at the Target cell and use the SearchDirection:=xlPrevious option. Something will always be found. If the row it is found is not the same row as Target then use the value in column E to populate the cell right of Target.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Columns(4), Target) Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = True
Dim trgt As Range, lastrw As Long
For Each trgt In Intersect(Columns(4), Target)
lastrw = Columns(4).Find(what:=trgt.Value, after:=trgt, _
lookat:=xlWhole, SearchDirection:=xlPrevious).Row
Debug.Print lastrw
If lastrw <> trgt.Row Then
trgt.Offset(0, 1) = Cells(lastrw, trgt.Column + 1).Value
End If
Next trgt
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
This should survive pasting multiple values into column D.
You can use .Find function with parameter SearchDirection:=xlPrevious
For case where you are searching word "AC" in a row 4:
Set FindCell = sh_wb_SF.Range("4:4").Find(What:="AC", LookIn:=xlValues, SearchDirection:=xlPrevious)
If FindCell Is Nothing Then
MsgBox ("Ooooooopppps")
End If
I've set up some VBA code in Excel that asks the user to select a second worksheet, then searches it for a value (a shared key linking the two sets of data, found 6 columns after Rng, where I want to add the retrieved value) in the second table and adds a value from that row to a column in the original table. The part of the program that I would like to adjust is the loop below.
It works fine if when I leave in the line to activate the CurFile workbook. But it means my screen is flashing a lot back and forth between the two workbooks. And once I start getting into hundreds or thousands of lines of data it will be ridiculously slow.
When I comment out that line, the value for FindCID doesn't change and it seems to just keep on refilling the same line, even though the value for r is updating. If after a few loops I add the activate line back in, it resumes properly filling in the results several lines down.
How can I streamline this? I originally was using ThisWorkbook references but even with explicitly defining CurFile (CurFile = ActiveWorkbook.Name) earlier it doesn't seem to go back to that workbook to look up the next value to search for, unless I reactivate the sheet.
Do While r <= maxRows
With Workbooks(CurFile).Worksheets("Sheet1")
Set Rng = .Range(Cells(r, c), Cells(r, c))
End With
FindCID = Rng.Offset(0, 6).Value
If Trim(FindCID) <> "" Then
With Workbooks(FN) ' found earlier by a function
.Activate
End With
With Sheets("Sheet1").Range("D:D")
Set FoundCell = .Find(What:=FindCID)
If Not FoundCell Is Nothing Then
PathLen = FoundCell.Offset(0, 2).Value
Workbooks(CurFile).Sheets("Sheet1").Activate 'If I comment out this line it doesn't work
Rng.Value = PathLen
MsgBox "CID found in " & FoundCell.Address & " Its value is " & PathLen
Else
MsgBox "Nothing found"
End If
End With
End If
On Error Resume Next
r = r + 1
Loop
Actually when working with objects, in most of the cases, there is no need to activate the workbooks\worksheets.
This is your code with some modifications in this regard:
Application.ScreenUpdating = False '(as suggested by CBRF23)
'......
'begining of your code
'......
Do While r <= maxRows
With Workbooks(CurFile).Worksheets("Sheet1")
Set Rng = .Cells(r, c) '(1)
End With
FindCID = Rng.Offset(0, 6).Value2
If Trim(FindCID) <> "" Then
Set FoundCell = Workbooks(FN).Sheets("Sheet1").Range("D:D").Find(What:=FindCID)
If Not FoundCell Is Nothing Then Rng.Value = FoundCell.Offset(0, 2).Value2
End If
r = r + 1
Loop
'......
'rest of your code
'......
Application.ScreenUpdating = True
(1) Notice that way the Range is defined as it’s made of only once Cell; but if the range has more than one Cell i.e. from Cell(r,c) to Cell(r,c+5) then you need to use the form:
Set Rng = Range(.Cells(r, c), .Cells(r, c+5))
There is no need to add a period . before Range as the range is defined by the Cells within the Range command. By using the period . before the Cell command they are referred as part of the
With Workbooks(CurFile).Worksheets("Sheet1")
However if the Range is defined as A1:F1 then the period . has to be added before the Range as in:
Set Rng = .Range(“A1:F1”)
I removed the MsgBox commands as I believe they were just for testing purposes. Not really showing these messages for hundreds or thousands lines of data. Isn’t it?
I wrote this script to delete rows which contain a value in column C that is different than "201103". When I use this to bold it, it works, but when I use it with .Delete it behaves strange and does not work properly.
I was trying to get selected rows and than use UNION to merge it and use .SELECT (multiple) so I could delete it manually but not sure how to make it.
Sub test()
Dim Cell As Range
For Each Cell In Range("C2:C2308").Cells
If (Cell.Value <> "201103" And Cell.Value <> "") Then
Cell.EntireRow.Font.Bold = True
'Cell.EntireRow.Delete
End If
Next Cell
End Sub
Does anyone know how to fix it so it works fine?
Try this:
Sub test()
'
With ActiveSheet
.AutoFilterMode = False
With Range("C2", Range("C" & Rows.Count).End(xlUp))
.AutoFilter 1, "<>201103"
On Error Resume Next
.Offset(1).SpecialCells(12).EntireRow.Delete
End With
.AutoFilterMode = False
End With
End Sub