Calculating Domains and Counts

As you can see, there was a problem with the Submit Comment form after "updating" Tips.net.
My most recent comment below was prepared using Notepad, then copy/pasted into the form.
Each End-of-Line (LF) character was ignored. This text was entered manually as a test.

The following text was copy/pasted from Notepad as a test:
Line 1
Line 2
Line 3

The Tip's macro can be simplified, and its expression for lastRow ignores possible hidden rows. Here's an alternate version:

Sub ListDomains2()
    Const DATA_COL = "D", OUTPUT_COLS = "H:I"
    Dim Domains As New Collection, Counts As New Collection
    Dim emailAddr As String, domain As String, item As Variant
    Dim lastRow As Long, atPos As Long, newCount As Long, n As Long
    'include possible hidden rows
    lastRow = Columns(DATA_COL).Find(What:="*", _
        After:=Columns(DATA_COL).Cells(1), LookIn:=xlFormulas, _
        LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious).Row
    For n = 1 To lastRow
        emailAddr = Trim(Cells(n, DATA_COL).Value)
        atPos = InStrRev(emailAddr, "@")
        If atPos > 0 Then
            domain = LCase(Mid(emailAddr, atPos + 1))
            On Error Resume Next
                Domains.Add domain, domain
                If Err = 0 Then 'new domain
                    newCount = 1
                Else 'must increment indirectly
                    newCount = Counts(domain) + 1
                    Counts.Remove domain
                End If
                Counts.Add newCount, domain
            On Error GoTo 0
        End If
    Next n
    'the following replaces everything in OUTPUT_COLS
    With Range(OUTPUT_COLS)
        .ClearContents
        Application.ScreenUpdating = False
        On Error GoTo EH
        .Cells(1, 1).Value = "Domain"
        .Cells(1, 2).Value = "Count"
        n = 1
        For Each item In Domains
            n = n + 1
            .Cells(n, 1).Value = item
            .Cells(n, 2).Value = Counts(item)
        Next item
EH:
        Application.ScreenUpdating = True
        .Show
    End With
End Sub

ListDomains and ListDomains2 illustrate limitations of the Collection object:
1. You can't directly modify its value (item).
2. You can't directly determine if a key exists.
3. You can't determine any of its keys.
The Dictionary object doesn't have these limitations, but it isn't included in the VBA library; you must use VB Editor's Tools menu to include a Reference to the Microsoft Scripting Runtime library. Here's a version that uses Dictionary:

Sub ListDomains3()
    Const DATA_COL = "D", OUTPUT_COLS = "H:I"
    'check Tools > References > Microsoft Scripting Runtime
    Dim Domains As New Dictionary
    Dim emailAddr As String, domain As String, key As Variant
    Dim lastRow As Long, atPos As Long, n As Long
    'include possible hidden rows
    lastRow = Columns(DATA_COL).Find(What:="*", _
        After:=Columns(DATA_COL).Cells(1), LookIn:=xlFormulas, _
        LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious).Row
    For n = 1 To lastRow
        emailAddr = Trim(Cells(n, DATA_COL).Value)
        atPos = InStrRev(emailAddr, "@")
        If atPos > 0 Then
            domain = LCase(Mid(emailAddr, atPos + 1))
            If Domains.Exists(domain) Then
                Domains(domain) = Domains(domain) + 1
            Else
                Domains.Add domain, 1
            End If
        End If
    Next n
    'the following replaces everything in OUTPUT_COLS
    With Range(OUTPUT_COLS)
        .ClearContents
        Application.ScreenUpdating = False
        On Error GoTo EH
        .Cells(1, 1).Value = "Domain"
        .Cells(1, 2).Value = "Count"
        n = 1
        For Each key In Domains.Keys
            n = n + 1
            .Cells(n, 1).Value = key
            .Cells(n, 2).Value = Domains(key)
        Next key
EH:
        Application.ScreenUpdating = True
        .Show
    End With
End Sub

The Tip begins with this Excel 2024 formula in cell F2n=UNIQUE(TEXTAFTER(D2:D3751, "@"))nbut this Excel 2021 formula gives a similar resultn=UNIQUE(MID(D2:D3751, FIND("@", D2:D3751) + 1, 999))nThe Tip says, "You can then place the following formula in cell G2:n=COUNTIF(D$2:D$3751, "*"&F2)nCopy it down as many cells as necessary and you then have your counts for each domain." If the formula in G2 references the array at F2 like thisn=COUNTIF(D$2:D$3751, "*"&F2#)nthen it is not necessary to "Copy it down...."nIf your version is earlier than Excel 2021, you can put this formula in cell F2 and "Copy it down..."n=MID(D2, FIND("@", D2) + 1, 999)nThen select column F, press Ctrl+C, choose Paste Special > Values, and use Data > Data Tools > Remove Duplicates to return the list of unique domains. Finally put this formula in cell G2 and "Copy it down..."n=COUNTIF(D$2:D$3751, "*"&F2)nto return the count for each unique domain.nNotice FIND("@", ...) returns a #VALUE! error if @ does not appear in the referenced cell; in this case, the previous formula suggested for cell F2 can be modified as follows:n=IFERROR(MID(D2, FIND("@", D2) + 1, 999), "")nRe. the Excel 2024 formulas, since TEXTAFTER(..., "@") returns a #N/A error if @ does not appear in the referenced cell, each expression that includes TEXTAFTER(..., "@") should be wrapped with TOCOL(..., 3), which removes blanks and errors. In this case, the range does not need to be qualified like D2:D9999; you can use D:D instead. The Tip says, "You can get rid of the TOCOL function if you, instead, use the TRIMRANGE function." This is correct only if @ appears in every cell within the TRIMRANGE result.

When I read this problem last week, I thought '=MID(D2, FIND("@",D2, LEN(D2) - LEN(SUBSTITUTE(D2, "@", "")) + 1) + 1, 255) would do the trick if you were using excel 2019 or earlier. nI ended up using an old excel trick where you replace each @ with 50 spaces, take the rightmost 50 characters and Trim the spaces , leaving the domain.nSo I used '=TRIM(RIGHT(SUBSTITUTE(D2,"@",REPT(" ",50)),50)) nfilled it down col E then selected columns D & E inserted a pivot table, draged Domain to Rows, Draged Domain to Values (count) and there I had a count of unique domains.