Only finds first Occurrence

[Steved]

Hello from Steved

Below works fine if I run it as a straight macro
ie sub Test()

Question when I ran it it would only do the first occurence
City and put city in all the others please what is required
for this to work.

Thankyou.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const sFIND As String = "TOTAL SHIFT HOURS"
Dim vArr As Variant
Dim rFound As Range
Dim nCount As Long

vArr = Array
("City", "Roskill", "Papakura", "Wiri", "Shore", "Orewa", "
Swanson", "Panmure")
nCount = 0
Set rFound = Cells.FIND( _
What:=sFIND, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False)
Do While Not rFound Is Nothing And nCount <= UBound
(vArr)
rFound.Value = vArr(nCount)
nCount = nCount + 1
Set rFound = Cells.FindNext(after:=rFound)
Loop


End Sub

 

[Tom Ogilvy]

Everytime you make a change in the change event, you fire another change
event. I suspect Excel just quits after awhile, overcome by frustration.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const sFIND As String = "TOTAL SHIFT HOURS"
Dim vArr As Variant
Dim rFound As Range
Dim nCount As Long

vArr = Array("City", "Roskill", "Papakura", _
"Wiri", "Shore", "Orewa", "Swanson", "Panmure")
nCount = 0
Application.EnableEvents = False
On Error goto ErrHandler
Set rFound = Cells.FIND( _
What:=sFIND, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False)
Do While Not rFound Is Nothing _
And nCount <= UBound (vArr)
rFound.Value = vArr(nCount)
nCount = nCount + 1
Set rFound = Cells.FindNext(after:=rFound)
Loop

ErrHandler:
Application.EnableEvents = True
End Sub

 

[Steved]

Hello Tom

Thanks very much.

-----Original Message-----
Everytime you make a change in the change event, you fire another change
event. I suspect Excel just quits after awhile, overcome by frustration.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const sFIND As String = "TOTAL SHIFT HOURS"
Dim vArr As Variant
Dim rFound As Range
Dim nCount As Long

vArr = Array("City", "Roskill", "Papakura", _
"Wiri", "Shore", "Orewa", "Swanson", "Panmure")
nCount = 0
Application.EnableEvents = False
On Error goto ErrHandler
Set rFound = Cells.FIND( _
What:=sFIND, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False)
Do While Not rFound Is Nothing _
And nCount <= UBound (vArr)
rFound.Value = vArr(nCount)
nCount = nCount + 1
Set rFound = Cells.FindNext(after:=rFound)
Loop

ErrHandler:
Application.EnableEvents = True
End Sub

--
Regards,
Tom Ogilvy





.