gravanoc
Active Member
- Joined
- Oct 20, 2015
- Messages
- 348
- Office Version
- 365
- Platform
- Windows
- Mobile
I have a range containing emails, and I need to decide if each is unique, primary, or secondary. Unique means it is never repeated in the entire list. Primary is repeated, but it is the first occurrence in the list of that e-mail. Secondary is everything else, a repeating e-mail on its 2nd or greater occurrence. I've tried a VBA solution but it has an issue. In the attached picture you can see it almost works correctly, but it labels the final e-mail in a set as unique instead of secondary, and I'm having a bad time trying to fix it. If a formula will do here, that will be fine. Thanks.
VBA Code:
Sub Emails()
Dim ws1 As Worksheet
Dim emRng As Range
Dim emStr() As String
Set ws1 = Sheets("Sheet1")
Set emRng = ws1.Range("C2:" & ws1.Range("C1048576").End(xlUp).Address)
Application.Calculation = xlCalculationManual
ReDim emStr(0 To emRng.Cells.Count)
For i = 0 To emRng.Cells.Count - 1
For j = 0 To i
If emRng.Cells(i + 1, 1).Value = emStr(j) Then
If emRng.Cells(i - 1, 1).Value <> emStr(j) Then
emRng.Cells(i, 2).Value = "Primary"
Exit For
End If
emRng.Cells(i, 2).Value = "Secondary"
Exit For
End If
Next
emStr(i) = emRng.Cells(i + 1, 1).Value
If emRng.Cells(i, 2).Value = "" Then emRng.Cells(i, 2).Value = "Unique"
Next
Application.Calculation = xlCalculationAutomatic
End Sub