Find Multiple Values, Copy to new Sheet and Count Number of times each entry appears

[AMarchetti]

Hi, I have been battling to find anything online that can assist me. I have a sheet that has email addresses in them and need to Find each email address and generate a list of all email addresses and how many times they appear in the sheet. I can use an Array with FindNext but how do I get it to find all the same emails address and return the number of time it appears in the sheet? Your help would be greatly appreciated.

eg. Sheet1

a@abc.com
b@abc.com
a@abc.com
c@abc.com
a@abc.com

NewSheet

a@abc.com 3
b@abc.com 1
c@abc.com 1

 

[Aladin Akyurek]

Sheet1, A2:A6...

[TABLE="class: grid, width: 135"]
<tbody>[TR]
[TD][/TD]
[/TR]
[TR]
[TD]a@abc.com[/TD]
[/TR]
[TR]
[TD]b@abc.com[/TD]
[/TR]
[TR]
[TD]a@abc.com[/TD]
[/TR]
[TR]
[TD]c@abc.com[/TD]
[/TR]
[TR]
[TD]a@abc.com[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Name A2:A6 of Sheet1 Email via the name box.

And define Ivec in Formulas | Name Manager as referring to:

=ROW(Email)-ROW(INDEX(Email,1,1))+1

Sheet2

[TABLE="class: grid, width: 182"]
<tbody>[TR]
[TD="align: right"]3[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]a@abc.com[/TD]
[TD="align: right"]3[/TD]
[/TR]
[TR]
[TD]b@abc.com[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD]c@abc.com[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[/TR]
</tbody><colgroup><col><col></colgroup>[/TABLE]
In A1 control+shift+enter, not just enter:

=SUM(IF(FREQUENCY(IF(1-(Email=""),MATCH(Email,Email,0)),Ivec),1))

In A2 control+shift+enter and copy down:

=IF(ROWS($A$2:A2)<=$A$1,INDEX(Email,SMALL(IF(FREQUENCY(IF(1-(Email=""),
     MATCH(Email,Email,0)),Ivec),Ivec),ROWS($A$2:A2))),"")

In B2 just enter and copy down:

=IF($A2="","",COUNTIFS(Sheet1!A:A,$A2))

 

[AMarchetti]

Thank you, but I need to use VBA Find as my sheet has thousands of other cells of text with email addresses scattered throughout the sheet. I need to search for these and then count how many times each email address appears.

 

[Prem Pal Singh]

Hi,

Please use the below code and change reference as per your request I assume that E mail id on sheet1 is starting from row 1 and the output will be on sheet 2 starting from row 1.
Sub count_Email()
Sheets("sheet1").Activate
Dim lr As Integer


lr = Sheets("sheet1").Range("A65536").End(xlUp).Row
With Sheets("sheet1")


.Range("A1:A" & lr).Copy Sheets("sheet2").Range("a1")
Sheet2.Activate
lsr = Sheets("sheet2").Range("A65536").End(xlUp).Row
Sheet2.Range("A1:A" & lsr).Sort , Key1:=Sheet2.Range("A1"), Order1:=xlAscending




For i = 1 To lsr
Sheet2.Range("b" & i).Value = Application.WorksheetFunction.CountIf(Sheet2.Range("A1:A" & lsr), Sheet2.Range("A" & i))


Next




For i = lsr To 2 Step -1
If Sheet2.Range("A" & i).Value = Sheet2.Range("A" & i).Offset(-1, 0).Value Then
Sheet2.Range("A" & i).EntireRow.Select
Selection.EntireRow.Delete
End If


Next
End With


End Sub
Thanks,
Prem Pal Singh

 

[AMarchetti]

Thank you. It is returning values, but how can I see which email address it is counting. It is putting values in Sheet2 but can it put the email address in the cell to the left so I can see the value it is counting?

Sorry, but I have been battling to work out the code to do this, so thanks for the help.

Hi,

Please use the below code and change reference as per your request I assume that E mail id on sheet1 is starting from row 1 and the output will be on sheet 2 starting from row 1.
Sub count_Email()
Sheets("sheet1").Activate
Dim lr As Integer


lr = Sheets("sheet1").Range("A65536").End(xlUp).Row
With Sheets("sheet1")


.Range("A1:A" & lr).Copy Sheets("sheet2").Range("a1")
Sheet2.Activate
lsr = Sheets("sheet2").Range("A65536").End(xlUp).Row
Sheet2.Range("A1:A" & lsr).Sort , Key1:=Sheet2.Range("A1"), Order1:=xlAscending




For i = 1 To lsr
Sheet2.Range("b" & i).Value = Application.WorksheetFunction.CountIf(Sheet2.Range("A1:A" & lsr), Sheet2.Range("A" & i))


Next




For i = lsr To 2 Step -1
If Sheet2.Range("A" & i).Value = Sheet2.Range("A" & i).Offset(-1, 0).Value Then
Sheet2.Range("A" & i).EntireRow.Select
Selection.EntireRow.Delete
End If


Next
End With


End Sub
Thanks,
Prem Pal Singh

 

[Aladin Akyurek]

Thank you, but I need to use VBA Find as my sheet has thousands of other cells of text with email addresses scattered throughout the sheet. I need to search for these and then count how many times each email address appears.

Did not notice that you needed VBA. Why not record a macro while you run advance filter with the Unique records only option checked?

 

[AMarchetti]

I have this which searches for the email address and then populates a new sheet with all the email addresses that it found, but how do I get it to show multiple values only once and then count how many times each email address appears in the sheet.

Sub UseArrayToCount()    
    Dim FirstAddress As String
    Dim MyArr As Variant
    Dim Rng As Range
    Dim Rcount As Long
    Dim I As Long
    Dim NewSh As Worksheet


    'With Application
    '    .ScreenUpdating = False
    '    .EnableEvents = False
    'End With


    MyArr = Array("@mua.co.za")


    'Set NewSh = Sheets("Sheet2")
    Set NewSh = Worksheets.Add


    With Sheets("Sheet1").Range("F:H")


        Rcount = 0


        For I = LBound(MyArr) To UBound(MyArr)


            Set Rng = .Find(What:=MyArr(I), _
                            After:=.Cells(.Cells.Count), _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                FirstAddress = Rng.Address
                Do
                    Rcount = Rcount + 1


                    Rng.Copy NewSh.Range("A" & Rcount)


                    ' NewSh.Range("A" & Rcount).Value = Rng.Value


                    Set Rng = .FindNext(Rng)
                Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
            End If
        Next I
    End With


    'With Application
    '    .ScreenUpdating = True
    '    .EnableEvents = True
    'End With
End Sub

 

[AMarchetti]

Anyone that can assist me, please?