Hello,

I want to re-arrange my existing macros in the excel file. I have a macro which goes to the specified sheet and checks column R if there are commas. If it finds the commas it replaces it to dots. Column R is called Email. But in some of documents Email doesn't have to be in the R column - sometimes it's S sometimes in a different place. I have a second macro which does a similar job. The second macro finds the Email column itself (no matter where it was located) and deletes commas at the end of found at the end of the email address. I thought it would be easy to amend this macro with the code from the first one to make it work...but I can't make it to work. Could anyone help me to properply amend the macro?

1-st macro which replaces commas in emails according to Column (R)

Sub GOOD_WORKS_Find_Replace_Commas_in_Emails()
    Sheets("Data").Activate
    Dim i As String
    Dim k As String
    i = ","
    k = "."
    Columns("R").Replace What:=i, Replacement:=k, LookAt:=xlPart, MatchCase:=False
    Sheets("Automation").Activate
    MsgBox "Removing commas in emails - Done!"
End Sub

2-nd macro which deletes dots at the end of email address (finds email column by itself)

Function getAllColNum(ByVal rowNum As Long, ByVal searchString As Variant) As Object
    Dim allColNum As Object
    Dim i As Long
    Dim j As Long
    Dim width As Long
    Set allColNum = CreateObject("Scripting.Dictionary")
    colNum = 1
    With ActiveSheet
        width = .Cells(rowNum, .Columns.Count).End(xlToLeft).Column
        For i = 1 To width
             If InStr(UCase(Trim(.Cells(rowNum, i).Value)), UCase(Trim(searchString))) > 0 Then
                 allColNum.Add i, ""
             End If '
        Next i
    End With
    Set getAllColNum = allColNum
End Function



Sub GOOD_WORKS_No_Dots_at_End_of_Emails()
    Dim strSearch As String
    strSearch = "Email"
    Dim colNum As Variant
    Dim allColNum As Object
    Sheets("Data").Activate
    Dim LR As Long, i As Long
    Set allColNum = getAllColNum(1, searchString)
    For Each colNum In allColNum
        LR = Cells(Rows.Count, colNum).End(xlUp).Row
        For i = 1 To LR
            With Range(Cells(i, colNum), Cells(i, colNum))
                If Right(.Value, 1) = "." Then .Value = Left(.Value, Len(.Value) - 1)
            End With
        Next i
    Next colNum
    Sheets("Automation").Activate
    MsgBox "No Dots at the end of email addresses - Done!"
End Sub

Recommended Answers

All 12 Replies

Try this

    Sub GOOD_WORKS_Find_Replace_Commas_in_Emails(ColId As Variant)    
        Sheets("Data").Activate    
        Dim i As String
        Dim k As String
        i = ","
        k = "."
        Columns(ColId).Replace What:=i, Replacement:=k, LookAt:=xlPart, MatchCase:=False
        Sheets("Automation").Activate
        MsgBox "Removing commas in emails - Done!"
    End Sub        

I haven't been able to test this. But I think it will give you enough to proceed. Basically I changed your first macro to take the Column Name or Index as an argument, then instead of lines 30-35 try Call GOOD_WORKS_Find_Replace_Commas_in_Emails(colNum.Name). Hope this helps.

Hi Tinstaafl,

I tried your amended code and I replaced lines 30-35 for Call GOOD_WORKS_Find_Replace_Commas_in_Emails(colNum.Name) but it doesn't seem to work for me. it returns an error "wrong number of arguments or invalid property assignment" in the "Call" line.
However, I have a strange feeling like I did something wrong. Below is the code which I was trying to use. Please let me know where is the mistake:

Function getAllColNum(ByVal rowNum As Long, ByVal searchString As Variant) As Object
    Dim allColNum As Object
    Dim i As Long
    Dim j As Long
    Dim width As Long
    Set allColNum = CreateObject("Scripting.Dictionary")
    colNum = 1
    With ActiveSheet
        width = .Cells(rowNum, .Columns.Count).End(xlToLeft).Column
        For i = 1 To width
             If InStr(UCase(Trim(.Cells(rowNum, i).Value)), UCase(Trim(searchString))) > 0 Then
                 allColNum.Add i, ""
             End If '
        Next i
    End With
    Set getAllColNum = allColNum
End Function



Sub GOOD_WORKS_Find_Replace_Commas_in_Emails()
    Dim strSearch As String
    strSearch = "Email"
    Dim colNum As Variant
    Dim allColNum As Object
    Sheets("Data").Activate
    Dim LR As Long, i As Long
    Set allColNum = getAllColNum(1, searchString)
    For Each colNum In allColNum
        Call GOOD_WORKS_Find_Replace_Commas_in_Emails(colNum.Name)
    Next colNum
    Sheets("Automation").Activate
    MsgBox "No Dots at the end of email addresses - Done!"
End Sub

You misunderstood what I said. Basically you'll end up with 3 routines, like this:

    Sub GOOD_WORKS_Find_Replace_Commas_in_Emails(ColId As Variant)
        Sheets("Data").Activate
        Dim i As String
        Dim k As String
        i = ","
        k = "."
        Columns(ColId).Replace What:=i, Replacement:=k, LookAt:=xlPart, MatchCase:=False
        Sheets("Automation").Activate
        MsgBox "Removing commas in emails - Done!"
    End Sub 

    Function getAllColNum(ByVal rowNum As Long, ByVal searchString As Variant) As Object
        Dim allColNum As Object
        Dim i As Long
        Dim j As Long
        Dim width As Long
        Set allColNum = CreateObject("Scripting.Dictionary")
        colNum = 1
        With ActiveSheet
        width = .Cells(rowNum, .Columns.Count).End(xlToLeft).Column
            For i = 1 To width
                If InStr(UCase(Trim(.Cells(rowNum, i).Value)), UCase(Trim(searchString))) > 0 Then
                allColNum.Add i, ""
                End If '
            Next i
        End With
        Set getAllColNum = allColNum
    End Function

    Sub GOOD_WORKS_No_Dots_at_End_of_Emails()
    Dim strSearch As String
    strSearch = "Email"
    Dim colNum As Variant
    Dim allColNum As Object
    Sheets("Data").Activate
    Dim LR As Long, i As Long
    Set allColNum = getAllColNum(1, searchString)
    For Each colNum In allColNum
        Call GOOD_WORKS_Find_Replace_Commas_in_Emails(colNum.Name)
    Next colNum
    Sheets("Automation").Activate
    MsgBox "No Dots at the end of email addresses - Done!"
    End Sub

Ok. But the code provided by you brings the Run-time Error '424' - saying object required. If I go to Debug mode it highlights the line 39:

Call GOOD_WORKS_Find_Replace_Commas_in_Emails(colNum.Name)

What's wrong with this?

oops I thought colNum was a the actual column but it's just the index. Try colNum instead of colNum.Name.

seems there is something missing as this call doesn't want to stop. it executes the macro overe and over again. I tried to use the analogy and just like End IF or End With to use End for or End call but it didn't help.
Is it not like if it goes to every row then it returns me the message (despite giving this message at the end of the process)?

How are you calling the macro?

I go to DEVELOPER --> MACROS --> select the macro and click run. At the final stage when the macro will run properly, I would create the action button and and assign macro to it

ok I'm gonna try and set up a spreadsheet to test this further. what format is the information in the column with the emails? is there a header named 'Email' then addresses in the cells, or does each cell contain the word 'email'?

I have 2 files which will be used to execute this macro. 1st file has a column with header Email, Second has the column Email - Person email. Below there is now word "email" there. Just pure email addresses. The macro doesn't have to be flexible to catch everything what contains the word "Email" if this is a case. I can set up 2 different macros. The button later could execute 1 macro for "email" and 1 for "email - person email"

Are the columns static in each one or do they change?

They change (as I stated in the first post)

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.