VBA с использованием Loop с значениями .find и .copy

Question

Я хочу использовать цикл в своей SearchFunction так, чтобы он искал клиента до тех пор, пока не будет найден правильный клиент. Я использую настраиваемый msgbox, чтобы определить, является ли найденный клиент клиентом, которого я искал.

Так основно я хочу это:

MsgBox "Is this the customer you were looking for?" 

Yes: it will copy cells(sheet2) and paste them into the invoice (sheet1) 
No: it will find next customer (and ask same question)** 

** And keep doing/asking this till last found customer is shown. 

Это как MsgBox выглядит, когда клиент был найден: Custom msgbox

На данный момент он ищет клиента и показывает его в пользовательский msgbox. Когда я говорю «Да, это клиент», он скопирует значения, подобные им, и вставляет их в счет-фактуру. Но когда я говорю «нет, это не мой клиент», он не пойдет к следующему найденному клиенту, но он выйдет из SearchFunction.

Я пробовал использовать Loop, но я не мог заставить его работать. Также я пытался .findnext, но я не мог вставить его в код, я использую ..

Это код, который я использую:

Sub SearchCustomer() 
' 
' Search for customer 
' 
'***************************************************************************************************** 


Dim Finalrow As Integer 
Dim I As Integer 
Dim cC As Object 
Dim iR As Integer 
Dim foundrange As Range 

'***************************************************************************************************** 
'          This Searches for the customer 
'***************************************************************************************************** 

' Set up searchrange 
    Set foundrange = Sheets("sheet2").Cells.Find(What:=Sheets("sheet1").Range("B12").Value, LookIn:=xlFormulas, LookAt:=xlPart) 

' Checks if fields are filled 
If Sheets("sheet1").Range("B12").Value = "" Then 
    MsgBox "Please fill in a search key", vbOKOnly, "Search customer" 

Else 

    'When nothing is found 
    If foundrange Is Nothing Then 
     MsgBox "Customer not found," & vbNewLine & vbNewLine & "Refine your search key", vbOKOnly, "Search customer" 

    Else 

     Finalrow = Sheets("sheet1").Range("A1000").End(xlUp).Row 

     For I = 2 To Finalrow 

      'When range is found 
      If Worksheets("sheet2").Cells(I, 1) = foundrange Then 
       Set cC = New clsMsgbox 
       cC.Title = "Search contact" 
       cC.Prompt = "Is this the customer you searched for?" & vbNewLine & "" & vbNewLine & Worksheets("sheet2").Cells(I, 1) & vbNewLine & Worksheets("sheet2").Cells(I, 2) _ 
       & vbNewLine & Worksheets("sheet2").Cells(I, 3) & vbNewLine & Worksheets("sheet2").Cells(I, 4) & vbNewLine & Worksheets("sheet2").Cells(I, 5) 
       cC.Icon = Question + DefaultButton2 
       cC.ButtonText1 = "Yes" 
       cC.ButtonText2 = "No" 
       iR = cC.MessageBox() 

       If iR = Button1 Then 
        'Name 
        Worksheets("sheet2").Cells(I, 1).Copy 
        Worksheets("sheet1").Range("B12").PasteSpecial xlPasteFormulasAndNumberFormats 
        'Adress 
        Worksheets("sheet2").Cells(I, 2).Copy 
        Worksheets("sheet1").Range("B13").PasteSpecial xlPasteFormulasAndNumberFormats 
        'Zipcode & City 
        Worksheets("sheet2").Cells(I, 3).Copy 
        Worksheets("sheet1").Range("B14").PasteSpecial xlPasteFormulasAndNumberFormats 
        'Phonenumber 
        Worksheets("sheet2").Cells(I, 4).Copy 
        Worksheets("sheet1").Range("B15").PasteSpecial xlPasteFormulasAndNumberFormats 
        'E-mail 
        Worksheets("sheet2").Cells(I, 5).Copy 
        Worksheets("sheet1").Range("B16").PasteSpecial xlPasteFormulasAndNumberFormats 

       ElseIf iR = Button2 Then 
        MsgBox "Customer not found", vbOKOnly, "Contact zoeken" 

       End If 

       Range("B12").Select 

      End If 'gevonden item 
     Next I 

    Application.CutCopyMode = False 

    End If 
End If 

End Sub 

Некоторые помощь будет здорово! Долгое время искали.

Спасибо, продвинутый!

Greets Микос

Answer 1

Вы должны перестроить свой код, то цикл не имеет смысла для цикла по результатам поиска. Вам нужен Do While Loop, смотрите примеры в Range.FindNext Method

Псевдо код:

Set foundrange = Sheets("sheet2").Cells.Find(What:=...) 
Do While Not foundrange Is Nothing 
    If Msgbox(<Customer data from foundrange.Row>) = vbYes Then 
     ' copy stuff 
     Exit Do ' we're done 
    Else 
     Set foundrange = Sheets("sheet2").Cells.FindNext(After:=foundrange) 
    End If 
Loop 

P.S. Это не дроиды, которые вы ищете!

Answer 2

Большое спасибо Andre451, потому что он решил мою проблему!

Окончательный код:

Sub SearchCustomer() 
' 
' Search customer 
' 
'***************************************************************************************************** 

    Dim Finalrow As Integer 
    Dim foundrange As Range 
    Dim answer As Integer 

'***************************************************************************************************** 
'          Search for customername 
'***************************************************************************************************** 
' Search Range 
Set foundrange = Sheets("sheet2").Cells.Find(What:=Sheets("sheet1").Range("B12").Value, LookIn:=xlFormulas, LookAt:=xlPart) 
Finalrow = Sheets("sheet1").Range("A:A").End(xlDown).Row 

' Checks if search range is filled 
If Sheets("sheet1").Range("B12").Value = "" Then 
    MsgBox "Please fill in a searchkey", vbOKOnly, "Search customer" 
Else 
    Do While Not foundrange Is Nothing 
     If MsgBox("Is this the customer you were looking for? " & foundrange, vbYesNo + vbQuestion, "Zoek klant") = vbYes Then 
      'Name 
      foundrange.Copy 
      Worksheets("sheet1").Range("B12").PasteSpecial xlPasteFormulasAndNumberFormats 
      'Address 
      foundrange.Offset(0, 1).Copy 
      Worksheets("sheet1").Range("B13").PasteSpecial xlPasteFormulasAndNumberFormats 
      'Zipcode and City 
      foundrange.Offset(0, 2).Copy 
      Worksheets("sheet1").Range("B14").PasteSpecial xlPasteFormulasAndNumberFormats 
      'Phonenumber 
      foundrange.Offset(0, 3).Copy 
      Worksheets("sheet1").Range("B15").PasteSpecial xlPasteFormulasAndNumberFormats 
      'Email 
      foundrange.Offset(0, 4).Copy 
      Worksheets("sheet1").Range("B16").PasteSpecial xlPasteFormulasAndNumberFormats 
      Exit Do 
     Else 
      Set foundrange = Sheets("sheet2").Cells.FindNext(After:=foundrange) 
      End If 
Loop 

Range("B12").Select 
Application.CutCopyMode = False 

End If 
End Sub 

Еще раз спасибо!