How do I perform a function in sequential dynamic ranges?

Question

VBA newbie here. I did find some information out there about coding these loops but I'm having a very hard time figuring out if and/or how it applies to my specific needs, so thank you in advance for any help you can give.

In order to QA information before it's formatted and uploaded, I want to cycle through multiple groups of dynamic ranges and check the information against another column within that range. Each range is grouped by an email address in column D, and I need to make sure that the same email is also listed in column G (I am going to delete columns B-D before upload). Since each grouping could be anywhere from 1 to 100 rows, I have coded how to define the ranges (below), but how can I add a loop to perform the check in each group individually?

The output for all of this should be a message box that either says, "All clear!" if the code finds no errors, or "[Name] isn't listed. Please add their information before continuing." if they aren't listed.

I'm assuming I should do some sort of Do While or Do Until or For loop for this, but then I get confused conceptually on whether to declare my variables in or outside of the loops and then how to concatenate possibly multiple unlisted names into the same message box at the end.

Here's what I have so far:

Sub QANameIsListed()
'Declare the variables.
Dim nRow As Long
Dim nStart As Long, nEnd As Long
Dim sEmail As String
Dim sName As String

'Figure out what first email address is.
sEmail = Range("D2").Text

'Figure out where first group data starts.
For nRow = 1 To 65536
    If Range("D" & nRow).Value = sEmail Then
        nStart = nRow
    End If
Exit For
Next nRow

'Figure out where first group data ends.
For nRow = nStart To 65536
    If Range("D" & nRow).Value <> sEmail Then
        nEnd = nRow
    End If
Exit For
Next nRow
nEnd = nEnd - 1

'Check whether the name is listed in the second column.
With Range("G" & nStart & ":G" & nEnd)
sName = Range("B" & nStart).Text & " " & Range("C" & nStart).Text
    Set c = .Find(sEmail)
    If c Is Nothing Then
        MsgBox (sName & " " & "isn't listed." _
        & "  " & "Please add their information before continuing.")
    Else
        MsgBox ("All clear!")
    End If
End With
End Sub

Answer 1

I see no real question in your post. :) However, here's my take.

First, you are placing your Exit For in the wrong place. If you place it outside the If---End If block, then your For loop will always exit before it reaches the Next nRow.

Second, you are looping through 65536 cells twice, which is not only resource intensive, it's not completely compatible as well. If my data was in row 65537, I'd totally evade the loop. In Excel 2007 onward, after all, there are a million available rows.

My suggestion is, use Find exclusively. We'll use it to find the first occurrence of sEmail from the top and the last occurrence of sEmail from the bottom. We'll return their row index for this. Of course, this works only with the assumption that your emails are sorted properly...

The final part is very simple, but it can escape some beginners, so no worries there. What we do is, we declare the range as determined from the above, and we will loop inside this range. You were almost there, so that's excellent.

My modification of your code is untested, but it captures what you tried to achieve and then maybe some. There are some lines I took the liberty of completely removing as I found them unnecessary (Set c = .Find(sEmail), for one). I also added some other "newbie-friendly" things, like a Boolean check and the quick and dirty method for multiple lines in a MsgBox.

Code follows:

Sub QANameIsListed()
'Declare the variables.
Dim nRow As Long
Dim nStart As Long, nEnd As Long
Dim sEmail As String
Dim sName As String
Dim cRng As Range, cL As Range 'BK201: Declare cRng.
Dim rStr As String 'BK201: For multiple unlisted names.
Dim aClr As Boolean 'BK201: To check if it's all clear.

'Figure out what the first email address is.
sEmail = Range("D2").Value

'Figure out where first group data starts.
nStart = Range("D:D").Find(sEmail).Row

'Figure out where first group data ends.
nEnd = Range("D:D").Rows.Find(What:=sEmail, SearchDirection:=xlPrevious).Row

'BK201: Set the target range.
Set cRng = Range("G" & nStart & ":G" & nEnd)

'BK201: Set a default value for aClr.
aClr = True

For Each cL In cRng
    'Similar to B and C.
    sName = cL.Offset(0, -5).Value & " " & cL.Offset(0, -4).Value
    If cL.Value = sEmail Then
        'Do nothing. Let the loop continue.
    Else
        aClr = False 'BK201: Oops. At least one entry isn't listed.
        rStr = rStr & sName & vbNewLine
    End If
Next cL

If aClr Then 'BK201: If all is clear...
    MsgBox "All clear!"
Else 'BK201: Otherwise...
    rStr = "The unlisted names are:" & vbNewLine & vbNewLine & rStr
    rStr = rStr & vbNewLine & vbNewLine & "Please add their information before continuing."
    MsgBox rStr
End If

End Sub

This doesn't end here, though, since this will only run properly for one email on your list, and that email is also located in D2 which is where nStart is going to default to anyway. So, even with the code above, my next suggestion is: It's better to have a list of all unique emails somewhere else, then iterate over that, with sEmail being equal to the email string of the current iteration.

If this sounds nice, then let us know so we can apply it accordingly. Otherwise, this code will work correctly on your current set-up or request as it is. :)

Result of test with sEmail located in M2 rather than D2 below:

MASSIVE EDIT:

As per exchange with OP, the following should do the trick. Please note however, that for my convenience, I took the liberty of assuming that a list of unique e-mails of all team leaders are located somewhere. Modify the code as necessary. Code follows:

Private Sub CheckIfLeadExists()

    'Dimension area.
    Dim wSht As Worksheet
    Dim rMem As Range
    Dim vList As Variant, vElement As Variant
    Dim lStart As Long, lEnd As Long
    Dim sEmail As String, sName As String, rStr As String
    Dim bClear As Boolean

    'Assignment area.
    Set wSht = ThisWorkbook.Sheets("Sheet1") 'Modify as necessary.
    vList = wSht.Range("J2:J4").Value 'Assign the unique e-mails to a variable.
    bClear = True 'Default value of boolean check for clear run.

    For Each vElement In vList 'Iterate over the e-mails.
        sEmail = vElement
        With wSht
            'Find the starting row for current e-mail of loop.
            lStart = .Columns("D").Find(sEmail).Row
            'Likewise, find the ending row for current e-mail of loop.
            lEnd = .Columns("D").Find(sEmail, SearchDirection:=xlPrevious).Row
            'Get the lead's name.
            sName = .Cells(lStart, 2).Value & " " & .Cells(lStart, 3).Value
            'Assign the member's area to a range.
            Set rMem = .Range("E" & lStart & ":G" & lEnd)
        End With
        'We now search this member's area for the current lead's e-mail.
        If Not rMem.Find(sEmail) Is Nothing Then
            'E-mail exists in member's area. Do nothing.
        Else
            bClear = False 'Oops. At least one entry isn't listed.
            rStr = rStr & sName & vbNewLine 'Add to string.
        End If
    Next vElement

    If bClear Then 'If all is clear...
        MsgBox "All clear!"
    Else 'Otherwise, list them all.
        rStr = "The unlisted names are:" & vbNewLine & vbNewLine & rStr
        rStr = rStr & vbNewLine & "Please add their information before continuing."
        MsgBox rStr
    End If

End Sub

Screencap of result:

LAST EDIT (HOPEFULLY):

Following code takes into account not having the list in advance. This will create the list in Column J instead.

Private Sub CheckIfLeadExists()

    'Dimension area.
    Dim wSht As Worksheet
    Dim rMem As Range
    Dim vList As Variant, vElement As Variant
    Dim lStart As Long, lEnd As Long, lRow As Long
    Dim sEmail As String, sName As String, rStr As String
    Dim bClear As Boolean
    Dim oDict As Object, vMails As Variant, vItem As Variant
    Dim lCount As Long

    'Assignment area.
    Set wSht = ThisWorkbook.Sheets("Sheet1") 'Modify as necessary.

    'Get first all the emails with duplicates. Modify as necessary.
    vMails = wSht.Range("D2:D" & Cells(Rows.Count, 4).End(xlUp).Row).Value
    'Create a dictionary.
    Set oDict = CreateObject("Scripting.Dictionary")
    With oDict
        For Each vItem In vMails
            If Not .Exists(vItem) And Not IsEmpty(vItem) Then
                .Add vItem, Empty
            End If
        Next vItem
    End With
    'Copy unique list of e-mails to column J.
    lRow = oDict.Count
    wSht.Range("J2").Resize(lRow, 1).Value = Application.Transpose(oDict.Keys)
    vList = wSht.Range("J2:J" & lRow + 1).Value 'Assign the unique e-mails to a variable.
    bClear = True 'Default value of boolean check for clear run.

    For Each vElement In vList 'Iterate over the e-mails.
        sEmail = vElement
        With wSht
            'Find the starting row for current e-mail of loop.
            lStart = .Columns("D").Find(sEmail).Row
            'Likewise, find the ending row for current e-mail of loop.
            lEnd = .Columns("D").Find(sEmail, SearchDirection:=xlPrevious).Row
            'Get the lead's name.
            sName = .Cells(lStart, 2).Value & " " & .Cells(lStart, 3).Value
            'Assign the member's area to a range.
            Set rMem = .Range("E" & lStart & ":G" & lEnd)
        End With
        'We now search this member's area for the current lead's e-mail.
        If Not rMem.Find(sEmail) Is Nothing Then
            'E-mail exists in member's area. Do nothing.
        Else
            bClear = False 'Oops. At least one entry isn't listed.
            rStr = rStr & sName & vbNewLine 'Add to string.
        End If
    Next vElement

    If bClear Then 'If all is clear...
        MsgBox "All clear!"
    Else 'Otherwise, list them all.
        rStr = "The unlisted names are:" & vbNewLine & vbNewLine & rStr
        rStr = rStr & vbNewLine & "Please add their information before continuing."
        MsgBox rStr
    End If

End Sub

Results are the same. Hope this helps!

FOLLOW-UP EDIT:

When dealing with dictionaries, since it is not always you encounter a dictionary with only one item (at least in my experience), Transpose is usually the best way to print out the keys or items to a range. However, with only one item in the dictionary, it fails to print it out (never bothered checking exactly why). However, looping through the keys or items is just fine and should result into printing out that lone key/item. See following edit.

Private Sub CheckIfLeadExists()

    'Dimension area.
    Dim wSht As Worksheet
    Dim rMem As Range
    Dim vList As Variant, vElement As Variant
    Dim lStart As Long, lEnd As Long, lRow As Long
    Dim sEmail As String, sName As String, rStr As String
    Dim bClear As Boolean
    Dim oDict As Object, vMails As Variant, vItem As Variant
    Dim lCount As Long

    'Assignment area.
    Set wSht = ThisWorkbook.Sheets("Sheet5") 'Modify as necessary.

    'Get first all the emails with duplicates. Modify as necessary.
    vMails = wSht.Range("D2:D" & Cells(Rows.Count, 4).End(xlUp).Row).Value
    'Create a dictionary.
    Set oDict = CreateObject("Scripting.Dictionary")
    With oDict
        For Each vItem In vMails
            If Not .Exists(vItem) And Not IsEmpty(vItem) Then
                .Add vItem, Empty
            End If
        Next vItem
    End With
    'Copy unique list of e-mails to column J.
    lRow = 2 '--Changed this.
    For Each Key In oDict.Keys '--Changed this as well.
        wSht.Range("J" & lRow).Value = Key
        lRow = lRow + 1
    Next Key
    vList = wSht.Range("J2:J" & lRow + 1).Value 'Assign the unique e-mails to a variable.
    bClear = True 'Default value of boolean check for clear run.

    For Each vElement In vList 'Iterate over the e-mails.
        sEmail = vElement
        With wSht
            'Find the starting row for current e-mail of loop.
            lStart = .Columns("D").Find(sEmail).Row
            'Likewise, find the ending row for current e-mail of loop.
            lEnd = .Columns("D").Find(sEmail, SearchDirection:=xlPrevious).Row
            'Get the lead's name.
            sName = .Cells(lStart, 2).Value & " " & .Cells(lStart, 3).Value
            'Assign the member's area to a range.
            Set rMem = .Range("E" & lStart & ":G" & lEnd)
        End With
        'We now search this member's area for the current lead's e-mail.
        If Not rMem.Find(sEmail) Is Nothing Then
            'E-mail exists in member's area. Do nothing.
        Else
            bClear = False 'Oops. At least one entry isn't listed.
            rStr = rStr & sName & vbNewLine 'Add to string.
        End If
    Next vElement

    If bClear Then 'If all is clear...
        MsgBox "All clear!"
    Else 'Otherwise, list them all.
        rStr = "The unlisted names are:" & vbNewLine & vbNewLine & rStr
        rStr = rStr & vbNewLine & "Please add their information before continuing."
        MsgBox rStr
    End If

End Sub

Results are the same on multiple groups, and it will not error out when only one group is present.

Let me know if this helps.