Solved Macro to delete only specific email addresses from a cell

November 13, 2017 at 23:36:22
Specs: Windows 8
I have a variable length 3 column spreadsheet with headers that can have as many as 5000 rows.

Col C contains multiple email addresses in each cell separated by a semicolon and a carriage return. Some cells may contain spaces between the next email address. Also, some cells in the Column may be blank.

I need to remove ONLY the *@gmail.com email addresses but keep all of the others.

Example
Col A = Company
Col B = Status
Col C = eMail addresss (i.e., joe.black@companyname.com; john.smith@gmail.com; jane.doe@companyname.com)

After the code is run I would like Col C to be joe.black@companyname.com; jane.doe@companyname.com (Cols A & B remain unchanged).

This is the code I'm using but it gets an error which I THINK is due to the blank spaces and/or cells in Col C.

Sub symaxf(): Dim n As Long, r As Long, S As String, T As String, Z
For r = 2 To Range("C" & Rows.Count).End(xlUp).Row
S = Trim(Range("C" & r)): Z = Split(S, ";")
For n = LBound(Z) To UBound(Z)
If Len(Z(n)) < 4 Then GoTo GetNext
If InStr(1, Z(n), "gmail.com") Then GoTo GetNext
T = T & ";" & Z(n)
GetNext: Next n
T = Right(T, Len(T) - 1): Range("C" & r).Value = T: T = "" <== This is where I error out
Next r
End Sub

Any help would be greatly appreciated!

message edited by symaxf


See More: Macro to delete only specific email addresses from a cell

Reply ↓  Report •

#1
November 14, 2017 at 02:28:42
✔ Best Answer
Here is my quick attempt at it, it seems to work, the code will need to be "Cleaned" up, rename some of the variables. Maybe a check and checkup procedure needs to be added to remove any additional ";" at the end of the email addresses.

Have a play

Dim i As Long
Dim DataString As Variant

Public Sub SplitData()

    DataString = Empty
    
    For Each bcell In Range("C2", Range("C" & Rows.Count).End(xlUp))
    
    DataString = Split(bcell.Value, ";")
    
    For intCount = LBound(DataString) To UBound(DataString) 'Step -1
        b = (Trim(DataString(intCount)))
        
        If InStr(1, b, "@gmail.com") Then
            
        Else
           x = x & b & ";"
        End If
        
        i = i + 1
        
    Next intCount
    
    bcell.Value = x
    
    x = vbNullString
    b = vbNullString
    
    
    
    Next bcell
    
End Sub


Reply ↓  Report •

#2
November 14, 2017 at 09:40:43
Well my Friend, your "quick attempt" was far better than my long agonizing beating of my head on the desk! It worked great. The only issue I had was that some of the email addresses are mixed case, i.e., *.Gmail.com or *.GMAIL.com. In these cases, the email address was not removed. Thanks you so much for "AlwaysWillingToLearn" and to Teach!

Reply ↓  Report •

#3
November 15, 2017 at 00:25:11
Hey,

That's brilliant, I guess you could add another clause in there to capture the upper case "GMAIL" or even use the 'like' operator to capture all occurrences, not sure if it will work though haven't tried it. Have a play. Glad it worked for you and thank you for letting us know.

Dim i As Long
Dim DataString As Variant

Public Sub SplitData()

    DataString = Empty
    
    For Each bcell In Range("C2", Range("C" & Rows.Count).End(xlUp))
    
    DataString = Split(bcell.Value, ";")
    
    For intCount = LBound(DataString) To UBound(DataString) 'Step -1
        b = (Trim(DataString(intCount)))
        
        If InStr(1, b, "@gmail.com") Or _
            InStr(1, b, "@GMAIL.com") Then
            
        Else
           x = x & b & ";"
        End If
        
        i = i + 1
        
    Next intCount
    
    bcell.Value = x
    
    x = vbNullString
    b = vbNullString
    
    
    
    Next bcell
    
End Sub

message edited by AlwaysWillingToLearn


Reply ↓  Report •

Related Solutions

#4
November 15, 2017 at 19:34:06
So, I tried it and (drum roll) looks like you took a good thing and made it even better!
Thanks again my friend!

Reply ↓  Report •

#5
November 16, 2017 at 00:26:54
Awesome glad it worked! always happy to help

Reply ↓  Report •

Ask Question