macro to search and replace with offset

[Tim]

Hi,

I need to create a macro which will search all
occurrences of "item1" in column D and copy the values to
the next cells in column B. The worksheet event below is
exactly what I need

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub

If Intersect(Target, Me.Range("a:a")) Is Nothing Then
Exit Sub

On Error GoTo errHandler:

With Target
If IsNumeric(.Value) Then
If .Value > 5 Then
Application.EnableEvents = False
.Offset(0, 3).Value="item1"
End If
End If
End With

errHandler:
Application.EnableEvents = True

End Sub

BUT there is an insoluble problem with it because
Worksheet Change event doesn't recognize a change by
pasting a value. So i need to change the above event to
code which will recognize change by pasting the value.
Any help is highly appreciated.

 

[Earl Kiosterud]

Tim,

Your worksheet change should be firing when stuff is pasted. If you're
pasting more than one cell, than this line will blow it out:
If Target.Cells.Count > 1 Then Exit Sub

You might try remming out this line (put an apostrophe in front of it) to
see if it runs when you paste. Or change it to

If Target.Cells.Count > 1 Then

MsgBox "Target.Cells.Count is: " & Target.Cells.Count & " Sub will now
be summarily terminated. Have a nice day"
Exit Sub
end if

 

[Tim]

Just tried it . If I put an apostrophe in front of "If
Target.Cells.Count > 1 Then Exit Sub" still doesn't work.
Changed the line to: If Target.Cells.Count > 1 Then

MsgBox "Target.Cells.Count is: " & Target.Cells.Count
& "
-doesn't work.

Yes I'm pasting more than one cell. If I paste only one
cell everything is OK but for more than one cell -doesn't
work.
Thank you for the help but I'm still waiting for the
right answer

 

[Bob Phillips]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range

If Intersect(Target, Me.Range("a:a")) Is Nothing Then Exit Sub

On Error GoTo errHandler:

For Each cell In Target
If IsNumeric(cell.Value) Then
If cell.Value > 5 Then
Application.EnableEvents = False
cell.Offset(0, 3).Value = "item1"
End If
End If
Next cell

errHandler:
Application.EnableEvents = True

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Guest]

It really works.
THANK YOU BOB!!!

 

[Dave Peterson]

I think I would modify your and Bob's code slightly:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim myRng As Range

Set myRng = Nothing
On Error Resume Next
Set myRng = Intersect(Target, Me.Range("a:a"))
On Error GoTo 0

If myRng Is Nothing Then Exit Sub

On Error GoTo errHandler:

For Each cell In myRng.Cells
If IsNumeric(cell.Value) Then
If cell.Value > 5 Then
Application.EnableEvents = False
cell.Offset(0, 3).Value = "item1"
End If
End If
Next cell

errHandler:
Application.EnableEvents = True

End Sub

Now if you paste in A1:X99, only the cells in column A are looked at.