Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 166
  • Last Modified:

distribution list

Hi,

I have a distribution list which i must de-dupe

So in one row i have

xyz@abc.com, abc@xyz.com, bcd@xyz.com

next row

ytr@xyz.com, abc@xyz.com

Note that abc@xyz.com is contained in both rows, i need some code that will delete any dupes, so that there is only one abc@xyz.com


I have 184 rows of names that it would need to loop through

Many thanks
0
Seamus2626
Asked:
Seamus2626
  • 4
  • 2
  • 2
3 Solutions
 
James ElliottCommented:
Do the names need to remain in rows, seperated by commas, or can be transpose the lot into a one-per-line-list?
0
 
Seamus2626Author Commented:
Lines dont have to remain in rows, as the end game is to paste into an email

Thanks Jell
0
 
Glenn RayExcel VBA DeveloperCommented:
Here's the quickest way, especially if this is a one-time event:

1) In Excel, select all cells in this column and copy
2) Open Word
3) Paste the values in Word
4) So a search and replace to convert the commas into paragraph marks:
search and replaceBe sure to add a space after the comma to remove leading spaces.  You'll see this:
results5) Copy all the converted text.
6) Switch back to Excel and open a blank sheet
7) Paste the values in cell A1
8) Menu:  Data tab, "Remove Duplicates"

That will leave you with just the unique email addresses.

Regards,
-Glenn
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
James ElliottCommented:
Try this (in a new module). It assumes all emails are in column A. It puts results in column B.

Option Explicit

Sub EE()

Dim ws As Worksheet
Dim LR As Long
Dim x As Long, y As Long, i As Long
Dim var As Variant
Dim arr() As Variant

Set ws = Sheets(1)
LR = ws.Range("A" & Rows.Count).End(xlUp).Row

ws.Range("B:B").Clear

For x = LR To 1 Step -1

    var = Split(ws.Cells(x, 1), ",")
    
        For y = LBound(var) To UBound(var)
        
            If Not InArr(var(y), arr) Then
            
                ReDim Preserve arr(i)
                arr(UBound(arr)) = Trim(var(y))
                i = i + 1
                
            End If
            
        Next y
Next x

ws.Range("B1").Resize(UBound(arr) + 1, 1).Value = Application.Transpose(arr)

Set var = Nothing
Set ws = Nothing

End Sub

Public Function InArr(p As Variant, arr As Variant) As Boolean

    Dim x As Long
    
        If Not IsArray(arr) Then Exit Function
        
        On Error GoTo err_handler
        
        For x = LBound(arr) To UBound(arr)
        
        
            If UCase(Trim(arr(x))) = UCase(Trim(p)) Then
            
                InArr = True
                Exit Function
            
            End If
            
        Next x
        
err_handler:
 
 Err.Clear
 
End Function

Open in new window

0
 
Seamus2626Author Commented:
Thanks!
0
 
Glenn RayExcel VBA DeveloperCommented:
You're welcome.  I routinely do this similar method for email distribution also.

-Glenn
0
 
Seamus2626Author Commented:
Jell, thats lovely code, sorry i assigned the pointst too early, il re-open and split, thanks
0
 
Seamus2626Author Commented:
Thanks all
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 4
  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now