Do Loop Until Loop

**carsto** · 02-16-2007, 04:34 PM

that is meaningless to me
I'm only just starting learning to write VBA code.

**jasoncw** · 02-16-2007, 05:49 PM

In the FIND function, using LookAt:=xlPart will create a match if the search string is located anywhere within the cell (i.e. it finds the match in "part" of the cell). Using LookAt:=xlWhole will only create a match if the "whole" cell matches the search string. Make sense?

Ok, I also played around with your code a little and came up with this. Let us know if it works as intended.

Sub FindData()

Dim FindIT As Variant
Dim response, frstMatch, Family As Range

Do
    FindIT = InputBox("Find What?")

    If StrPtr(FindIT) = 0 Then  'Cancel was pressed
        Exit Sub

    ElseIf Len(FindIT) = 0 Then  'OK pressed but nothing entered
        MsgBox "You must enter a value."
        
    End If

Loop

On Error GoTo NotFound

Sheets("Part Number Database").Select
Columns("A:A").Select

Cells.Find(What:=FindIT, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
    xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
    .Activate
    
frstMatch = ActiveCell.Address

    Do
    
        response = MsgBox(ActiveCell.Value, vbYesNoCancel)
    
            If response = vbCancel Then
                Exit Sub
        
            ElseIf response = vbYes Then
      
            'after vbYes it copies the family of part numbers to the UserForm sheet
        
                Set Family = Range(ActiveCell, ActiveCell.End(xlToRight))
                Family.Copy
                Sheets("UserForm").Range("B1").PasteSpecial Paste:=xlAll, _
                    Operation:=xlNone, SkipBlanks:=False, Transpose:=True
                Application.CutCopyMode = False
                Exit Sub
            
            End If
        
        Cells.Find(What:=FindIT, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
            xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
            .Activate
        
    Loop Until ActiveCell.Address = frstMatch


MsgBox "You have run out of options.  Try again."

Exit Sub

NotFound:
    MsgBox "The entry cannot be found."
    Exit Sub
   
End Sub

**carsto** · 02-19-2007, 05:37 PM

Thank a million Jason!

It works great with one small thing that needs corrected.
I ONLY want it to search in Column A

Sheets("Part Number Database").Select
Columns("A:A").Select

Doesn't seem to be forcing it to only look in Column A, consequently it loops thru a LOT of options, if you keep saying NO!

Also, right now, it's finding one potential match at a time and asking Yes or No.
Is it possible to find all the potential matches on the page at once, and either copy them to another worksheet or pop them into a ListBox for scrolling through?

**jasoncw** · 02-19-2007, 05:43 PM

Originally Posted by carstowal

Thank a million Jason!

It works great with one small thing that needs corrected.
I ONLY want it to search in Column A

Sheets("Part Number Database").Select
Columns("A:A").Select

Doesn't seem to be forcing it to only look in Column A, consequently it loops thru a LOT of options, if you keep saying NO!

Oops, sorry about that. There are 2 different parts in the code that state "Cells.Find". You can just change both of these to "Selection.Find" and this issue will be cured.

Originally Posted by carstowal

Also, right now, it's finding one potential match at a time and asking Yes or No.
Is it possible to find all the potential matches on the page at once, and either copy them to another worksheet or pop them into a ListBox for scrolling through?

Sorry, it was my impression that is what you wanted. What would you like to see listed for multiple finds, the cell address, or other data?

**carsto** · 02-19-2007, 05:49 PM

Yes, my original intent was to just say No, No, No until you get to the one you want.
However my illustrious coworkers feel answering NO multiple times is too much work!
(Their other option is they could enter the FULL Part Number into the Find Box – Lazy Bums!)

Ahh!, but that’s what macros are for right – automating the work!

**ccrux** · 06-11-2007, 05:39 PM

Hi there!
This post is interesting for me. I have a trouble very very similar. I wanted use that code for my userform but doesn't work!
My case is:
I have a worksheet with people data (personal id, name, fiscal id, address, etc), I have a find userform with 2 option buttons and 2 textboxes. Where when I choose one of the option buttons one of the textbox is disabled, so I choose what kind of finding I want, then I write in the enabled textbox what I want to find. The code of the ok button is:

Private Sub cmdOK_Click()
'
'Opening sheet
Sheets("CC").Visible = True
ActiveWorkbook.Sheets("CC").Activate
ActiveWindow.DisplayGridlines = False
'setting variables
Dim CveRFC As String
CveRFC = txtRFC.Value
'Set NomDen to txtNombre textbox
Dim NomDen As String
NomDen = txtNombre.Value
If optBuscaRFC = True Then
'Starting RFC search
Dim RFCIni As String
RFCIni = "$D$7"
Dim RFCFin As String
Range(RFCIni).Select
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
RFCFin = ActiveCell.Offset(-1, 0).Address

'Now we set my search range
ActiveWorkbook.Names.Add Name:="RanBusqRFC", RefersToR1C1:=Range(RFCIni, RFCFin)
Application.Goto Reference:="RanBusqRFC"
Set BuskRFC = Selection.Find(What:=CveRFC, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
'If RFC (or part of the RFC) I put in the textbox doesn't exist in my range I exit from search
If Not BuskRFC Is Nothing Then
BuskRFC.Activate
Dim CveClisRFC As String
CveClisRFC = (ActiveCell.Offset(0, -3).Value)
Dim NomClisRFC As String
NomClisRFC = UCase(ActiveCell.Offset(0, -1).Value)
Dim ClaveRFC As String
ClaveRFC = UCase(ActiveCell.Value)
'I notify whose is the RFC
MsgBox "Name: " & NomClisRFC & Chr(13) & "R.F.C.: " _
& ClaveRFC, vbInformation, "Searching goals"
Dim ResponseRFC
ResponseRFC = MsgBox("¿Is that right?", vbYesNo + vbQuestion, "Checking information")
If ResponseRFC = vbYes Then
MsgBox "Personal ID is: " & CveClisRFC, vbInformation, "Pay attention..."
Sheets("CC").Visible = False
Sheets("Detalle").Activate
Exit Sub
Else
'HERE I NEED SOMETHING TO CONTINUE UNTIL I FIND WHAT I'M SEARCHING OR UNTIL THE SEARCHING GOES BACK TO THE FIRST ADDRESS FOUND
Unload Me
Sheets("CC").Visible = False
Sheets("Detalle").Activate
Exit Sub
End If
Else
'If I don't find nothing I send the error message
Unload Me
MsgBox "R.F.C. you put doesn't exist", vbCritical, _
"R.F.C. doesn't exist"
Sheets("CC").Visible = False
Sheets("Detalle").Activate
Exit Sub
End If

Else
'Starting name search

Dim NomIni As String
NomIni = "$C$7"
Dim NomFin As String
Range(NomIni).Select
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
NomFin = ActiveCell.Offset(-1, 0).Address

'Set the searching range
ActiveWorkbook.Names.Add Name:="RanBusqNom", _
RefersToR1C1:=Range(NomIni, NomFin)
Application.Goto Reference:="RanBusqNom"
Set BuskNom = Selection.Find(What:=NomDen, After:=ActiveCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
'If the name I put doesn't exist I exit
If Not BuskNom Is Nothing Then
BuskNom.Activate
Dim CveClisNom As String
CveClisNom = (ActiveCell.Offset(0, -2).Value)
Dim NomClisNom As String
NomClisNom = UCase(ActiveCell.Value)
Dim RFCsNom As String
RFCsNom = UCase(ActiveCell.Offset(0, 1).Value)
MsgBox "Name: " & NomClisNom & Chr(13) & "R.F.C.: " & _
RFCsNom, vbInformation, "Searching goals"
Dim ResponseNom
ResponseNom = MsgBox("¿Is that right?", vbYesNo + vbQuestion, "Checking information")
If ResponseNom = vbYes Then
MsgBox "Personnal ID is: " & CveClisNom, _
vbInformation, "Pay attention..."
Sheets("CC").Visible = False
Sheets("Detalle").Activate
Exit Sub
Else
'HERE I NEED SOMETHING TO CONTINUE UNTIL I FIND WHAT I'M SEARCHING OR UNTIL THE SEARCHING GOES BACK TO THE FIRST ADDRESS FOUND

Unload Me
Sheets("CC").Visible = False
Sheets("Detalle").Activate
Exit Sub
End If
End If
End If
End Sub

As you can check, my trouble is continue the searching until I find that I looking for or until the search start from the first address found again.

Thanks for your help!!

**ccrux** · 06-12-2007, 10:20 AM

Hi again!
I got it!!

This is the code:
Private Sub cmdOK_Click()
Dim CveRFC$, NomDen$

'Abrimos el Catálogo de Clientes
Sheets("CC").Visible = True
ActiveWorkbook.Sheets("CC").Activate
ActiveWindow.DisplayGridlines = False

'Asignamos el nombre CveRFC al valor del campo txtRFC
CveRFC = txtRFC.Value
'Asignamos el nombre NomDen al valor del campo txtNombre
NomDen = txtNombre.Value

If optBuscaRFC = True Then
'Iniciamos la búsqueda por RFC
Call BuscarRFC(CveRFC, NomDen)
Else
'Iniciamos la búsqueda por nombre
Call BuscarNombre(NomDen)
End If

Unload Me
Sheets("CC").Visible = False
Sheets("Detalle").Activate
End Sub
Private Sub BuscarRFC(CveRFC As String, NomDen As String)
Dim RFCIni$, RFCFin$, frstMatch$
Dim CveClisRFC$, NomClisRFC$, ClaveRFC$
Dim ResponseRFC%

RFCIni = "$D$7"
Range(RFCIni).Select
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
RFCFin = ActiveCell.Offset(-1, 0).Address

'Establecemos nuestro rango de búsqueda e iniciamos con la operación
ActiveWorkbook.Names.Add Name:="RanBusqRFC", RefersToR1C1:=Range(RFCIni, RFCFin)
Application.GoTo Reference:="RanBusqRFC"

On Error GoTo NotFound

Selection.Find(What:=CveRFC, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False).Activate
frstMatch = ActiveCell.Address

'Si el RFC que ingresamos existe en nuestro catálogo, comenzamos a informar de los
'resultados
Do
With ActiveCell
CveClisRFC = .Offset(0, -3).Value
NomClisRFC = UCase(.Offset(0, -1).Value)
ClaveRFC = UCase(.Value)
End With
ResponseRFC = MsgBox("Nombre: " & NomClisRFC & vbCrLf & "R.F.C.: " & ClaveRFC, _
vbYesNo + vbQuestion, "¿Es correcto?")
If ResponseRFC = vbYes Then
MsgBox "La clave del cliente es: " & CveClisRFC, vbInformation, "Tome nota..."
Exit Sub
End If
Selection.Find(What:=CveRFC, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False).Activate
Loop Until ActiveCell.Address = frstMatch
MsgBox "La entrada no arrojó resultados satisfactorios", vbCritical, _
"Búsqueda fallida"
Exit Sub

'Pero si no encontramos nada informamos de ello
NotFound:
MsgBox "La clave de R.F.C. que ingresó no existe", vbCritical, _
"R.F.C. no existe"
Exit Sub
End Sub

Thanks everyone!!

Claudio C.

Do Loop Until Loop

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Find using vba

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions