Do Loop Example Lab2

Send Snippet To: Save this snippet to Code Collector Pro -- view all surfrgeek's snippets
language: Other
license: Other

Code for Snippet:

                
Option Explicit
 
' Do loops can be one of four forms:
'
' Do Until ...
'   body of loop
' Loop
'
' Do While ...
'   body of loop
' Loop
'
' Do
'   body of loop
' Loop Until ...
'
' Do
'   body of loop
' Loop While ...
'
' In each of these, ... stands for a condition, and "body of loop" can be
' any sequence of statements.  In the first two forms, there is a possibility that
' the body of the loop will never be executed, not even once.  However, this is
' impossible in the last two forms.  In these, the body of the loop will certainly
' be executed at least once.
'
' You can often use any one of these four forms to implement given logic.  You just
' have to think through which way will be most "natural". To illustrate, suppose there
' are columns of names under row 1 (where row 1 has labels like "Cust1999"). We want
' to go through the names in a selected column to see whether any matches "Kreuger".
' We do not know how many names are in any column -- there could even be zero names
' in a column. The following subs illustrate alternative ways to perform the task.
 
' This first sub uses a Do Until form.
Sub DoLoop1()
    Dim selectedColumn As Integer
    Dim nColumns As Integer
    Dim rowCount As Integer
    Dim foundName As Boolean
    Dim requestedName As String
 
 
 
    ' Count the columns.
    With Range("A1")
        nColumns = Range(.Offset(0, 0), .End(xlToRight)).Columns.Count
    End With
 
    ' Ask for a name to be searched for.
        requestedName = InputBox("What last name do you want to search for?")
 
 
    selectedColumn = InputBox("Enter a column number from 1 to " & nColumns)
 
    ' Go to the top of the selected column.
    With Range("A1").Offset(0, selectedColumn - 1)
        rowCount = 1
        foundName = False
 
        ' Keep going until a blank cell is encountered. Note that if there are no names
        ' at all in the selected column, the body of this loop will never be executed.
        Do Until .Offset(rowCount, 0).Value = ""
            If UCase(.Offset(rowCount, 0).Value) = UCase(requestedName) Then
                foundName = True
                MsgBox requestedName & " was found as name " & rowCount & " in column " & _
                    selectedColumn & ".", vbInformation, "Match found"
                ' Exit the loop prematurely as soon as a match is found.
                Exit Do
            Else
                ' Unlike a For loop, any counter must be updated manually in a Do loop.
                rowCount = rowCount + 1
            End If
        Loop
    End With
 
    ' Display appropriate message if no match is found.
    If Not foundName Then
        MsgBox "No match for " & requestedName & " was found.", vbInformation, "No match"
    End If
End Sub
 
' This sub is identical to DoLoop1 except that a Do While is now used, with the
' opposite condition.
Sub DoLoop2()
    Dim selectedColumn As Integer
    Dim nColumns As Integer
    Dim rowCount As Integer
    Dim foundName  As Boolean
    Dim requestedName As String
 
 
    ' Count the columns.
    With Range("A1")
        nColumns = Range(.Offset(0, 0), .End(xlToRight)).Columns.Count
    End With
 
    ' Ask for a name to be searched for.
    requestedName = InputBox("What last name do you want to search for?")
 
    ' End of Validation Loop
    selectedColumn = InputBox("Enter a column number from 1 to " & nColumns)
 
    ' Go to the top of the selected column.
    With Range("A1").Offset(0, selectedColumn - 1)
        rowCount = 1
        foundName = False
 
        ' Keep going while the next cell isn't blank. Note that if there are no names
        ' at all in the selected column, the body of this loop will never be executed.
        Do While .Offset(rowCount, 0).Value <> ""
            If UCase(.Offset(rowCount, 0).Value) = UCase(requestedName) Then
                foundName = True
                MsgBox requestedName & " was found as name " & rowCount & " in column " & _
                    selectedColumn & ".", vbInformation, "Match found"
                ' Exit the loop prematurely as soon as a match is found.
                Exit Do
            Else
                ' Unlike a For loop, any counter must be updated manually in a Do loop.
                rowCount = rowCount + 1
            End If
        Loop
    End With
 
    ' Display appropriate message if no match is found.
    If Not foundName Then
        MsgBox "No match for " & requestedName & " was found.", vbInformation, "No match"
    End If
End Sub
 
' This is almost the same as DoLoop1 except that the Until condition is placed at
' the end of the loop. This form works even if there are no names in the list, but
' I find it logically confusing if you think this might be the case. (I prefer DoLoop1
' or DoLoop2 in that case.)
Sub DoLoop3()
    Dim selectedColumn As Integer
    Dim nColumns As Integer
    Dim rowCount As Integer
    Dim foundName  As Boolean
    Dim requestedName As String
 
    With Range("A1")
        nColumns = Range(.Offset(0, 0), .End(xlToRight)).Columns.Count
    End With
 
    ' Ask for a name to be searched for.
    requestedName = InputBox("What last name do you want to search for?")
 
    selectedColumn = InputBox("Enter a column number from 1 to " & nColumns)
 
    With Range("A1").Offset(0, selectedColumn - 1)
        rowCount = 1
        foundName = False
 
        ' Keep going as long as a blank cell is not encountered. Note that if there are no names
        ' at all in the selected column, the body of this loop will never be executed.
        Do
            If UCase(.Offset(rowCount, 0).Value) = UCase(requestedName) Then
                foundName = True
                MsgBox requestedName & " was found as name " & rowCount & " in column " & _
                    selectedColumn & ".", vbInformation, "Match found"
                ' Exit the loop prematurely as soon as a match is found.
                Exit Do
            Else
                ' Unlike a For loop, the counter must be updated manually in a Do loop.
                rowCount = rowCount + 1
            End If
        Loop Until .Offset(rowCount, 0).Value = ""
    End With
 
    ' Display appropriate message if no match is found.
    If Not foundName Then
        MsgBox "No match for " & requestedName & " was found.", vbInformation, "No match"
    End If
End Sub
 
' This sub is identical to DoLoop3 except that a Loop While is now used, with the
' opposite condition.
Sub DoLoop4()
    Dim selectedColumn As Integer
    Dim nColumns As Integer
    Dim rowCount As Integer
    Dim foundName  As Boolean
    Dim requestedName As String
 
    With Range("A1")
        nColumns = Range(.Offset(0, 0), .End(xlToRight)).Columns.Count
    End With
 
    ' Ask for a name to be searched for.
    requestedName = InputBox("What last name do you want to search for?")
 
    selectedColumn = InputBox("Enter a column number from 1 to " & nColumns)
 
    With Range("A1").Offset(0, selectedColumn - 1)
        rowCount = 1
        foundName = False
 
        ' Keep going as long as a blank cell is not encountered. Note that if there are no names
        ' at all in the selected column, the body of this loop will never be executed.
        Do
            If UCase(.Offset(rowCount, 0).Value) = UCase(requestedName) Then
                foundName = True
                MsgBox requestedName & " was found as name " & rowCount & " in column " & _
                    selectedColumn & ".", vbInformation, "Match found"
                ' Exit the loop prematurely as soon as a match is found.
                Exit Do
            Else
                ' Unlike a For loop, the counter must be updated manually in a Do loop.
                rowCount = rowCount + 1
            End If
        Loop While .Offset(rowCount, 0).Value <> ""
    End With
 
    ' Display appropriate message if no match is found.
    If Not foundName Then
        MsgBox "No match for " & requestedName & " was found.", vbInformation, "No match"
    End If
End Sub
 
Sub Challenge()
    Dim foundCell, rng, myrange, lastCell As Range
    Dim foundName As Boolean
    Dim fnd, firstFound, response As String
    Dim isValid As Boolean
 
 
    ' Ask for a name to be searched for.
    isValid = False
    Do
    fnd = InputBox("What last name do you want to search for?")
 
    'Check if the input is NULL
        If fnd = "" Then
            'Check if user wants to quit
            response = MsgBox("Empty Input. Do you want to quit?", vbYesNo, "QUIT?")  'Header reflects QUIT scenario
            If response = vbYes Then
                Exit Sub                'Exit the entire Sub; no point in continuing with other stuff at bottom
            Else
                'Not quitting; display proper error message and continue validation
                MsgBox "You must enter a valid value (e.g., Smith)" ' vbExclamation, "NO DATA ENTRY"  'Header reflects no Data Entry scenario
            End If
 
        'Input not blank; validate input for other requirements
 
        'Check if input is non-numeric
        ElseIf IsNumeric(fnd) Then
            MsgBox "Last name must be a non-numeric value (e.g., Smith)", vbExclamation, "NUMERIC ENTRY"  'Header reflects non-numeric scenario
 
        'If the control reaches here, it means the input is valid; change the Flag to "True" to exit DO LOOP
        Else
            isValid = True
 
        End If
 
    Loop Until isValid = True
 
    ' End of Validation Loop
 
    Set myrange = ActiveSheet.UsedRange
    Set lastCell = myrange.Cells(myrange.Cells.Count)
    Set foundCell = myrange.Find(what:=fnd, after:=lastCell)
 
    'Test to find name
        If Not foundCell Is Nothing Then
            firstFound = foundCell.Address
        Else
            GoTo NothingFound
        End If
 
    Set rng = foundCell
 
    'Loop through all unique finds
        Do Until foundCell Is Nothing
    'Find next cell with fnd value
        Set foundCell = myrange.FindNext(after:=foundCell)
 
    'Add found cell to rng range variable
        Set rng = Union(rng, foundCell)
        If foundCell.Address = firstFound Then Exit Do
 
    Loop
 
'Highlight Found cells red
  rng.Interior.Color = RGB(255, 0, 0)
 
'Report Message
  MsgBox rng.Cells.Count & " cell(s) were found containing: " & fnd
 
Exit Sub
 
'Display appropriate message if no match is found
NothingFound:
  MsgBox "No match for " & fnd & " was found.", vbInformation, "No match"
 
End Sub
 
Sub Clear()
 
Cells.Interior.ColorIndex = xlNone
 
End Sub
 
comments powered by Disqus

Info

Link to this snippet:


Download to Code Collector

To use the direct link to your snippet on CodeCollector.net either copy the html from the above section or drag the Download to Code Collector to where you would like to use it.

More Info:

Times Viewed: 23
Date Added: 2017-09-06 16:38:55
Last Modified: 2017-09-09 14:05:31

Web Analytics