"FindNext" function

[Giri]

Hi Guys,

I am quite new to VBA and have set myself the task of creating a macro that finds a particular word, inserts that same word in the cell next to it and then fills that cell with a red background.

I'm having two problems at the moment:

1) When the input box appears and I type in a WORD as opposed to a single letter, I get an error here - ".Offset(0, 1) = inp", saying "Runtime Error 91". This error also occurs with some letters..but not others... I have a feeling this has something to do with the position of some of these letters??

2) Also this line "Set fCell = rCell.FindNext(inp)" is producing the following error: "Unable to get FindNext property of the Range Class"

I think there are other problems too.. because it seems that sometimes when I search for a letter, it copies that letter to a cell that is not adjacent to where it was originally found....

Any help would be greatly appreciated!!

Kind Regards

Giri

Public Sub FindnCopyRed()
Dim inp As String
Dim Searchbox As String
Dim found As String
Dim fCell As Range
Dim rCell As Range
Dim nCell As Range
Set rCell = Range("A1:X100")
inp = InputBox("What do you want to find?", "Search")
Set fCell = rCell.Find(inp)
Do
With fCell
.Offset(0, 1) = inp
End With
Set nCell = fCell.Offset(0, 1)
nCell.Interior.Color = vbRed
Set fCell = rCell.FindNext(inp)
Loop Until fCell Is Nothing
End Sub

[mdmackillop]

Look for FindNext in VBA Help and modify the exaple code.

[mancubus]

and this may help...

http://www.ozgrid.com/VBA/find-method.htm

[GTO]

Hi Giri,

I kept getting pulled away, but had started on this. See if this helps...

Option Explicit

Sub exa()
Dim strSearchFor As String
Dim strFirstAddress As String
Dim rngSearch As Range
Dim rngFoundCell As Range
Dim rngCells As Range

strSearchFor = InputBox("What do you want to find?", "Search")

'// In case user doesn't enter anything to search for... //
If strSearchFor = vbNullString Then Exit Sub

Set rngSearch = Range("A1:X100")

'// See if we find the string at least once. //
Set rngFoundCell = RangeFound(rngSearch, strSearchFor, , xlValues, xlWhole)


If Not rngFoundCell Is Nothing Then

'// Save the address of the first found cell, so we'll know when to quit. //
strFirstAddress = rngFoundCell.Address
'// Create another reference so we can "collect up" all the cells found. //
Set rngCells = rngFoundCell


Do
'// Keep looking until we run back into our first found cell, adding //
'// to our 'collection' of found cells. //
Set rngFoundCell = rngSearch.FindNext(rngFoundCell)
Set rngCells = Application.Union(rngCells, rngFoundCell)
Loop While Not rngFoundCell.Address = strFirstAddress

'// Then run through all the cells found ... //
For Each rngFoundCell In rngCells
rngFoundCell.Offset(, 1).Value = rngFoundCell.Value
rngFoundCell.Offset(, 1).Interior.Color = vbRed
Next
End If
End Sub

Function RangeFound(SearchRange As Range, _
Optional FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function
Mark

[Giri]

Hi Guys,

Thanks so much for the responses!

I tried editing the code yesterday and came up with the below. It seems to be working properly. This bit of code came from the VBA Help:

Loop While Not fCell Is Nothing And fCell.Address <> firstAddress

but I don't quite understand the second part

"fCell.Address <> firstAddress"

Could someone please explain to me what that means exactly?

BTW GTO, thanks so much for posting that up!! I will have a look at it as well. There are a few commands there that I am not familiar with so it will be a great learning experience to go through what you have done. Big thank you!

Kind Regards

Giri


Public Sub FindnCopyRed()
Dim inp As String
Dim Searchbox As String
Dim found As String
Dim fCell As Range
Dim rCell As Range
Dim nCell As Range
Dim firstAddress As Variant
Set rCell = Range("D1:D16")
inp = InputBox("What do you want to find?", "Search")
Set fCell = rCell.Find(inp)
If Not fCell Is Nothing Then
firstAddress = fCell.Address
End If
Do
With fCell
.Offset(0, 1) = inp
End With
Set nCell = fCell.Offset(0, 1)
nCell.Interior.Color = vbRed
Set fCell = rCell.FindNext(fCell)
Loop While Not fCell Is Nothing And fCell.Address <> firstAddress
End Sub

[mdmackillop]

"fCell.Address <> firstAddress"

Could someone please explain to me what that means exactly?
Put 3 identical values on a worksheet and use Find to locate the first. Click Find Next button repeatedly and you will loop around the 3 values. In the code, the loop is broken when you return to the first found item; "FirstAddress".

BTW, Please use the green VBA button to format code as shown. It makes it easier to follow.

[Giri]

Hi Everyone,

Haven't been able to work much on my VBA recently, but am getting back into it!

With this code, I am getting an error message on the line I have highlighted in bold. It's the "Runtime Error 438" message. Does anyone know how I can fix this?

Thanks for your assistance!

Kind Regards,

Giri


Option Explicit
Public Sub FindCopy()
Dim inp As String
Dim ws As Range
Dim fCell As Range
Dim fCellOrig As Variant
Dim nCell As Range
Dim rCell As Integer
Dim x, n As Integer
Dim sr As String
Dim numFound As Integer
Dim cellrow As Integer
Dim wbNew As Workbook
Set ws = Range("A2:Q40")
inp = InputBox("What do you want to find?")
Set fCell = ws.Find(inp)
If inp = vbNullString Then Exit Sub
If fCell Is Nothing Then
MsgBox "Word Could Not be Found!"
Exit Sub
End If
If Not fCell Is Nothing Then
fCellOrig = fCell.Address
End If
x = 1
Set wbNew = ThisWorkbook
Do
Set nCell = fCell.Offset(-1)
rCell = nCell.Row
ActiveSheet.Rows(rCell).Copy
wbNew.Sheets("Sheet2").Range("A:x").Paste
Set fCell = ws.FindNext(fCell)
x = 1 + x
Loop While Not fCell Is Nothing And fCell.Address <> fCellOrig
End Sub

[mdmackillop]

Put both items on one line and paste to the top left cell to avoid mismatched areas.

ActiveSheet.Rows(rCell).Copy wbNew.Sheets("Sheet2").Range("A1")