Find Text in cell and copy to cell 7 columns over (Excel 2003)

Topic

New Reply

I need to find the TEXT “HCE” anywhere in the cells D:D1000 and copy the found cell contents to a new cell 7 columns to the right of the cell with the text
then loop through the next cells.
This is thecode I have so far

Sub Find_HCE()
Const StrText = “HCE”
Dim rng As Range
Set rng = Range(“D:D1000”).Find(What:=StrText, LookIn:=xlValues, LookAt:=xlPart)
Do While Not rng Is Nothing
rng.Copy _
Destination:=Range(“K1000”).End(xlUp).Offset(0, 7)
Set rng = Range(“D:D1000”).FindNext
Loop
End Sub

Can you help with a correction?

Reply | Quote

Replies

D:D1000 is not a valid range – do you mean D1:D1000 or D2:D1000 perhaps?
If you want to copy the cell contents to 7 columns to the right of the cell in column D you should copy to rng.Offset(0, 7). If you use column K and then offset 7 columns to the right, you end up in column R. Moreover, Range(“K1000”).End(xlUp).Offset(0, 7) will be the same cell all the time, so each value will overwrite the previous one.
With FindNext, you must specify after which cell you want to start otherwise you’ll keep on finding the first occurrence.
And you must test that you haven’t looped back to the beginning.

Here is a working version:

Sub Find_HCE()
Const StrText = "HCE"
Dim rng As Range
Dim strFirst As String
Set rng = Range("D1:D1000").Find(What:=StrText, LookIn:=xlValues, LookAt:=xlPart)
If Not rng Is Nothing Then
strFirst = rng.Address
Do
rng.Copy Destination:=rng.Offset(0, 7)
Set rng = Range("D1:D1000").FindNext(After:=rng)
Loop Until rng Is Nothing Or rng.Address = strFirst
End If
End Sub

Reply | Quote

Wow! Thanks Hans. You really are a Magician.
How about a hypothetical so I can learn something else.
If instead of Copying the Cell to a new Cell 7 columns over,
how would the code read if I just wanted put an x in a cell 7 columns to the right of the cell with the found text?

Reply | Quote

Change the line

rng.Copy Destination:=rng.Offset(0, 7)

to

rng.Offset(0, 7) = "x"

Reply | Quote

Hans:
Thanks for the lesson

Reply | Quote