FindNext (XP;SR3)

[jstevens]

I am having an issue with the Case vbNo where I am trying to find the next "c" in the rangename "R_Names". I can find the first item but if it is not what I'm looking for I want to select the "NO" button from the message box which will then bring be to the next "c" and etc..

Var1 = ActiveCell
Do Until IsEmpty(ActiveCell)
With ThisWorkbook.Sheets("Unique_Users").Range("R_Names ")
Set c = .Find(Var1, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
True, SearchFormat:=False)

If Not c Is Nothing Then

intResult = MsgBox(c.Offset(0, -2).Value & Chr(13) & _
c.Offset(0, -1).Value & Chr(13) & _
c.Offset(0, 0).Value, vbYesNoCancel + vbQuestion)

Select Case intResult
Case vbYes
ActiveCell.Offset(0, 2) = c.Offset(0, -2).Value
ActiveCell.Offset(0, 3) = c.Offset(0, -1).Value
ActiveCell.Offset(0, 4) = c.Offset(0, 0).Value
Case vbNo
Set c = .FindNext©
Case vbCancel
End
End Select
End If
End With
ActiveCell.Offset(1, 0).Select
Var1 = ActiveCell
Loop


Any assistance would be appreciated.
John

[HansV]

Could you post a sample workbook to test on?

[LegareColeman]

Without the workbook to test on, I could not test the code below. See if it gets you any closer to what you want.

<pre> Var1 = ActiveCell
With ThisWorkbook.Sheets("Unique_Users").Range("R_Names ")
Do Until IsEmpty(ActiveCell)
Set c = .Find(Var1, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
True, SearchFormat:=False)
If Not c Is Nothing Then
Do While True
intResult = MsgBox(c.Offset(0, -2).Value & Chr(13) & _
c.Offset(0, -1).Value & Chr(13) & _
c.Offset(0, 0).Value, vbYesNoCancel + vbQuestion)
Select Case intResult
Case vbYes
ActiveCell.Offset(0, 2) = c.Offset(0, -2).Value
ActiveCell.Offset(0, 3) = c.Offset(0, -1).Value
ActiveCell.Offset(0, 4) = c.Offset(0, 0).Value
ActiveCell.Offset(1, 0).Select
Var1 = ActiveCell
Exit Do
Case vbNo
Set c = .FindNext©
Case vbCancel
End
End Select
Loop
End If
Loop
End With
</pre>

[jstevens]

Hans,

Please find attached a file with an example of what I am trying to accomplish.

Thanks,
John

[jstevens]

Legare,

Your recommendation puts the code in a never ending loop. I just attached an example file.

John

[LegareColeman]

It runs fine on my system. Could you be more specific about what you did to get it into a loop?

[HansV]

Try this slightly extended version of Legare's code:

Sub Test()
Dim var1 As String
Dim c As Range
Dim intResult As Integer
Dim r As Range
var1 = ActiveCell
With ThisWorkbook.Sheets("Unique_Users").Range("R_Names ")
Do Until IsEmpty(ActiveCell)
Set c = .Find(var1, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
True, SearchFormat:=False)
If Not c Is Nothing Then
Set r = c
Do
intResult = MsgBox(c.Offset(0, -2).Value & Chr(13) & _
c.Offset(0, -1).Value & Chr(13) & _
c.Offset(0, 0).Value, vbYesNoCancel + vbQuestion)
Select Case intResult
Case vbYes
ActiveCell.Offset(0, 2) = c.Offset(0, -2).Value
ActiveCell.Offset(0, 3) = c.Offset(0, -1).Value
ActiveCell.Offset(0, 4) = c.Offset(0, 0).Value
ActiveCell.Offset(1, 0).Select
var1 = ActiveCell
Exit Do
Case vbNo
Set c = .FindNext©
If c = r Then
ActiveCell.Offset(1, 0).Select
var1 = ActiveCell
Exit Do
End If
Case vbCancel
Exit Sub
End Select
Loop
End If
Loop
End With
End Sub

[jstevens]

Hans/Legare,

Thank you.

John