Instead of looping through all the cells in the range you can just
seek out the cells that contain myword. I assume that rng is the total
range. I will use the find method

dim rng as range
dim fnd as range
dim fadd as string
dim myword as string
dim myword2 as string
dim myword3 as string


myword = (InputBox(Prompt:="Enter myword", Default:="House"))
myword2 = (InputBox(Prompt:="Enter myword2", Default:="Day"))
myword3 = (InputBox(Prompt:="Enter myword2", Default:="Month"))

set fnd = rng.find( Myword, Lookin:=xlvalues, Lookat:= xlpart)

fadd = fnd.address

Do
if instr(1, fnd.offset(1,0).value, myword2) 0 then
fnd.entirerow.interior.color =RGB(204, 255, 204)
else
if instr(1, fnd.offset(1,0).value, myword3) 0 then
fnd.entirerow.interior.color = RGB(255, 255, 153)
end if
end if
set fnd = rng.findnext(fnd)
loop while not fnd is nothing and fadd < fnd.address








jsd219 wrote:
Can you help me with this one also? below you will see part of the
script. When the script finds the cells with "House" in the contents it
should then check the cell directly below it. If the cell below
contains "myword2" the row with "myword" should be colored RGB(204,
255, 204) if the cell below has "myword3" then the row with "myword"
should be colored RGB(255, 255, 153)

myword = (InputBox(Prompt:="Enter myword", Default:="House"))
myword2 = (InputBox(Prompt:="Enter myword2", Default:="Day"))
myword3 = (InputBox(Prompt:="Enter myword2", Default:="Month"))

For Each cell In rng
start_str = InStr(1, cell.Value, myword, vbTextCompare)
If start_str Then
cell.EntireRow.Interior.Color = RGB(204, 255, 204)
Range("B" & cell.Row).Value = 0
cell.Offset(0, 1).Value = Trim(Left(cell.Value, start_str -
1))
cell.Value = Trim(Right(cell.Value, Len(cell.Value) -
start_str + 1))
End If

start_str2 = InStr(1, cell.Value, myword2, vbTextCompare)
If start_str2 Then
cell.EntireRow.Interior.Color = RGB(255, 204, 0)
Range("B" & cell.Row).Value = 1
End If

If start_str3 Then
cell.EntireRow.Interior.Color = RGB(255, 153, 0)
Range("B" & cell.Row).Value = 1
End If

God bless
jsd219

bobbo wrote:
If the cell value is "Families with dogs Chapter 1" and the chapter
number is always the last thing in the text, you could try something
like this. I will use interim variables to make the method easier to
follow.

dim c as long
dim d as long
dim f as long

c = instr(1, cell.value, "Chapter")
' This returns the number of the first occurence of "Chapter" in the
cell value starting at
' the first letter in the cells text.
d = instr(c, cell.value, " ")
' This returns the number of the first space after "Chapter" in the
cells text.
f = len(cell.value) - d
' This takes the total number of characters and subtracts the number
of the last space
' f should always be one or two in your example.

Range("A" & cell.row).value = strings.right(cell.value, 2)







jsd219 wrote:
ooops, i got it. i should not have put the cell at the beginning. thank
you. ok now that i have that i need to take it up a notch.

the cells look like this:

Families with dogs Chapter 1

the script i am using finds the cells based on an input box. in this
case i use "Chapter" to find the cells. i need to copy the chapter
number into column "A". the chapter number will range form single digit
to double digit. Any ideas?

God bless
jsd219


bobbo wrote:
Try this

Range("B" & cell.row).value = 0


jsd219 wrote:
I am using a script to search out cells with specified text within a
specific column, once it finds these cells it make several changes, one
action is a number needs to be placed in another cell of another
column. The cell with the specified content is in column "N" and i need
to place a "0" in column "B".
i am currently using the line below to do the task: i would like to not
rely on an offset and have it find column "B" can anyone help me with
this please.

cell.Offset(0, -12).Value = "0"

God bless
jsd219