Pulling email lists by domain

Hi,

I need help with pulling a column of email lists and then separating them according to domain.

For example, in column A, I would have several addresses such as:

12345@gmail.com
123@gmail.com
2352@hotmail.ca
23526@hotmail.com
asdf@hotmail.com
2352@yahoo.ca
46373@yahoo.ca
asdf@gmail.com

For column B, for example, I want to have all the addresses from gmail.com, for C, hotmail.com, D, yahoo.ca, e.t.c.

The only two ways off the top of my head that could have helped were autofilters and delimeters, but those methods have limitations and really didn't help.

Thanks,
J

Try: =IF(ISERR(FIND("@gmail.com",A2,1)),"",A2) for your column B

Hi Steve,

I made a few cell changes in you formula and it worked. I now know what to do with the other columns for the other domains.

Would you happen to know another formula that would bring back the addresses with the same name, but they would be next to each other, row by row?

The formula that you gave me pulled all the gmails from A and put them to B, but for all the emails that weren't gmail in A, there is a blank in B.

It's easier formatting and organizing for me if I could somehow get all the gmails all bunched up.

sinasdf,

Attached is a sample workbook with a button assigned to the following macro:

Sub SeparateDomainsMacro_for_sinasdf()
    
    Dim rngEmail As Range: Set rngEmail = Range("A1", Cells(Rows.Count, "A").End(xlUp))
    
    Dim EmailCell As Range, rngDomain As Range, DomainCell As Range, rngDest As Range
    Dim Domain() As String
    Dim DomainFound As Boolean
    Dim DomainIndex As Long, DomainMax As Long
    
    Application.ScreenUpdating = False
    ActiveSheet.UsedRange.Offset(0, 1).Clear
    
    For Each EmailCell In rngEmail
        If EmailCell.Row > 1 Then
            DomainFound = False
            For DomainIndex = 1 To DomainMax
                If Domain(DomainIndex) = LCase(Trim(Split(EmailCell.Value, "@")(1))) Then
                    DomainFound = True
                    Exit For
                End If
            Next DomainIndex
            If DomainFound = False Then
                DomainMax = DomainMax + 1
                ReDim Preserve Domain(1 To DomainMax)
                Domain(DomainMax) = LCase(Trim(Split(EmailCell.Value, "@")(1)))
                rngEmail.AutoFilter 1, "*" & Domain(DomainMax)
                Set rngDest = Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)
                Set rngDomain = rngEmail.Offset(1, 0).Resize(rngEmail.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
                With rngDest
                    .Value = Domain(DomainMax)
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Font.Bold = True
                    .Font.Size = 12
                    For Each DomainCell In rngDomain
                        Cells(Rows.Count, .Column).End(xlUp).Offset(1, 0).Value = DomainCell.Value
                    Next DomainCell
                    .EntireColumn.AutoFit
                End With
            End If
        End If
    Next EmailCell
    
    rngEmail.AutoFilter
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
End Sub

Hope that helps,
~tigeravatar

Hi Tiger,

Thanks for your effort but unfortunately I'm not acquainted well with macros, so I don't use them as much. I also tried that and I got an error, but I appreciate your help.

I actually found an easy way to make the emails appear on top of one another after 'pulling', using the auto filter and selecting "non blanks".

Thanks again for your help folks!

-J