VBA FindNext Misses one occurrence - excel

I tried to replicate the code for finding all the values in a specific range and writing "here" in a cell next to them, but I have a problem with exiting the loop, it always misses one occurrence.
Can anyone explain the solution to me please?
Sub TestValue()
Dim c As Range
Dim firstAddress As String
With shGCD.Range("U:U")
Set c = .Find("THIS", lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Offset(, 1).Value = "Here"
Set c = .FindNext(c)
Loop While firstAddress <> .FindNext(c).Address
End If
End With
End Sub

Change this:
Loop While firstAddress <> .FindNext(c).Address
to this:
Loop While firstAddress <> c.Address
You have already updated c, so you should look at the address of the current c and not its successor.

Recoded for clarity and catching error if no initial find.
Sub TestValue()
Dim c As Range
Dim firstAddress As String
With ActiveSheet.Range("U:U")
Set c = .Find("THIS", lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address()
Else
GoTo ExitNoMatch
End If
Do While Not c Is Nothing
c.Offset(, 1).Value = "Here"
Set c = .FindNext(c)
If c.Address = firstAddress Then Set c = Nothing
Loop
End With
ExitNoMatch:
End Sub 'TestValue
HTH

Related

How can I make my sub-procedure dynamic to loop through a range?

I have a log that keeps track of what documents my employees have read. When they have read one in person, I manually change the color of the cell in my workbook. Then I have a macro that will look for any cells with the same document name as its value and will match the color. I want to be able to do this with all documents without having to write this macro for every document. I have tried for loops and do loops but I don't fully understand how they work.
Here is a picture of my code, the first sub procedure Match1 works perfectly fine for one document within a worksheet. MatchAll is where I had problems.
I get "Run-time error '1004':
Method 'Range' of object '_Global' failed" a lot or "object variable or with block variable not set"
EDIT:
Public Sub Match1()
Dim c As Range
Dim firstAddress As String
firstAddress = Range("A10").Value
With Range("C1:K500")
Set c = .Find(firstAddress, LookIn:=xlValues)
If Not c.Interior.Color = Range("A10").Interior.Color Then
firstAddress = c.Address
Do
c.Interior.Color = Replace(firstAddress, firstAddress, Range("A10").Interior.Color)
Set c = .FindNext(c)
Loop While Not c.Interior.Color = Range("A10").Interior.Color
End If
End With
End Sub
Public Sub MatchAll()
Dim a As Range
Dim i As Integer
Dim c As Range
Dim firstAddress As String
For i = 8 To 197
a = Range(1, i)
firstAddress = a.Value
With Range("C1:K500")
Set c = .Find(firstAddress, LookIn:=xlValues)
If Not c.Interior.Color = a.Interior.Color Then
firstAddress = c.Address
Do
c.Interior.Color = Replace(firstAddress, firstAddress, a.Interior.Color)
Set c = .FindNext(c)
Loop While Not c.Interior.Color = a.Interior.Color
End If
End With
Next i
End Sub

How to find values in a range with .FindNext?

I need to find cells with a value of "b" in range A1:A14. There are three such values in that range.
If a value is found, then set B2 to "yes", and then offset one row below.
In this code I wrote the findNext function doesn't work.
Sub sinep()
Dim sinepRng As Range
Dim rangeRover As Range
Set rangeRover = Range("B2")
Set sinepRng = Range("A1:A14").Find("b", LookIn:=xlValues)
If Not sinepRng Is Nothing Then
firstAddress = sinepRng.Address
MsgBox "first address " & firstAddress
Do
rangeRover.Value = "yes"
Set rangeRover = rangeRover.Offset(1, 0)
Set sinepRng = Range("A1:A14").Find("b").FindNext(sinepRng)
MsgBox "third address " & sinepRng.Address
If sinepRng Is Nothing Then
MsgBox "isnothing"
GoTo DoneFinding
End If
Loop While sinepRng.Address <> firstAddress
End If
DoneFinding:
This code does work.
Sub nag()
Dim rangeRover As Range
Set rangeRover = Range("B2")
With Worksheets(1).Range("a1:a500")
Set c = .Find("b", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
rangeRover.Value = "yes"
Set rangeRover = rangeRover.Offset(1, 0)
Set c = .FindNext(c)
If c Is Nothing Then
GoTo DoneFinding
End If
Loop While c.Address <> firstAddress
End If
DoneFinding:
End With
End Sub
I figure the problem lies within the findNext. I tried modifying it without success. I also tried using Find with After parameter.
Thanks #Rory for the solution.
I had to remove .find("b") from the line Set sinepRng = Range("A1:A14").Find("b").FindNext(sinepRng).

Why is Find object searching through the whole data instead of a specified Range?

I am new to Vba(and coding in general) and have written a very basic macro to find out "wood" inside a particular column from a larger set of data, however when I try to run it, it's still searching from the whole data set instead of the specified column.
I started with keeping the range of Cel to the whole data set, and then just narrowed it to the third column. However, when I remove the find element the immediate window shows me the address of cells in the third column, just as I want, but as soon as I use Find, it searches through the whole dataset.
I've tried defining propertied in Find object such as After and SearchOrder, but then it shows an error.
Dim emptyrow As Long
emptyrow = WorksheetFunction.CountA(Range("A:A")) + 1
Dim Cel As Range
Dim n As Integer
Set Cel = Range("C2:C54")
For n = 2 To emptyrow
Debug.Print (Cel.Cells(n,3).Find("wood","C2",,,xlByColumn).Address)
Next n
On using properties of Find, I get a type mismatch error.
It's not clear what exactly you want to do with the results, but here are a couple of possible outputs.
Sub xx()
Dim rFind As Range, s As String, v() As Variant, i As Long
With Range("C2:C54")
Set rFind = .Find(What:="Wood", After:=.Cells(.Cells.Count), _
Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then
s = rFind.Address
Do
Debug.Print rFind.Offset(, -2).Value 'column A value in immediate window
i = i + 1
ReDim Preserve v(1 To i)
v(i) = rFind.Offset(, -2).Value 'or store values in an array
Set rFind = .FindNext(rFind)
Loop While rFind.Address <> s
End If
End With
MsgBox Join(v, ", ")
End Sub
Use this:
Sub fnd_all_wood()
Dim c As Range
Dim firstaddress As String
With Range("C2:C54")
Set c = .Find("wood", LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
Debug.Print c.Address
Set c = .FindNext(c)
If c Is Nothing Then
GoTo DoneFinding
End If
Loop While c.Address <> firstaddress
End If
DoneFinding:
MsgBox "Done All"
End With
End Sub
This will print all the Cell Address in Range C2:C54 where it finds Wood
More information about the Formula Range.FindNext in the Link.
Update:
You can change the line Debug.Print c.Address to any other code where you can get the row by c.row and use it to get the other values like cells(c.row,1) to get the value from Ist column.
Demo:

Loop to find and mark with color does not stop - not sure why

I have a simple piece of code - when I run it separately it works and ends normally, however when I run it along with a some other code (they do not refer to each other at any point) the macro is still working in the background - from what I see on the screen the break occurs on this task - not sure why, any tips for a beginner ?
With Worksheets(1).Range("a1:a500")
Set c = .Find("Urgent", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Interior.Color = RGB(255, 0, 0)
Set c = .FindNext(c)
Loop While Not c Is Nothing
End If
End With
The condition of the Do-Loop should be like this - Loop While c.Address <> firstAddress
Otherwise, the .FindNext(c) would start repeating the cells, which were already looped through:
Sub Test()
Dim c as Range
Dim firstAddress as String
With Worksheets(1).Range("A1:A500")
Set c = .Find("Urgent", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Interior.Color = RGB(255, 0, 0)
Set c = .FindNext(c)
Loop While c.Address <> firstAddress
End If
End With
End Sub

Find and Select Dates

I am looking to build a simple macro to find a date and select all the cells that contain this date (I then have another working macro that modifies the selected cells). However I cant get the find and select to work.
At the moment the code is picking up the first "Jul-18" and then it is spitting out the no match message.
Any help would be much appreciated;
Sub FIND()
On Error GoTo nomatch
Cells.FIND(What:=Jul - 18, LookIn:=xlValues).Select
nomatch:
MsgBox ("Not Found")
End Sub
You should be able to adapt it to your needs easily.
[![enter image description here][1]][1]
Sub FindAndSelectAll()
Dim str As String, c As Range, r As Range
Dim strFind As String
Dim rSearch As Range
Set rSearch = ActiveSheet.Cells
strFind = InputBox("Please enter search string")
With rSearch
Set c = .Find(strFind, LookIn:=xlValues)
If Not c Is Nothing Then
Set r = c
str = c.Address
Do
Set r = Union(r, c)
ActiveSheet.Range(c.Address).Activate
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> str
End If
.Activate
If Not r Is Nothing Then r.Select
End With
End Sub

Resources