Multi Find & Replace - Speed Question

[tradeaccepted]

I am using the Multiple Find and Replace VBA from ExtendOffice. This is my exact scenario:

1. Receive a list of Email Address headers. My data is all in Column A and for clarity lets say the Header Column is called "Email To".
   1. Each cell in this column has multiple email addresses separated by a semicolon ( ; ). The format of the email addresses are:
      1. LAST, FIRST < EXAMPLE@EMAIL.COM > <example@email.com> ; LAST, FIRST [EXAMPLE@EMAIL.COM] ; LAST, FIRST (EXAMPLE@EMAIL.COM)</example@email.com>
2. As you can see, the email address can be surrounded by <>, []. or (). The end goal of this task is to have the cell read like this:
   1. LAST, FIRST ; LAST, FIRST ; LAST, FIRST
3. I have created two macros that will do the following:
   1. Takes all values from column A and delimits them by a semicolon. Then stacks all email addresses into one column.
   2. Removes all email addresses from the cell, leaving only the LAST, FIRST.

After these two macros are run, I am left with 130,000 individual emails stacked into columns B, and the matching normalized name in column C ( LAST, FIRST).


Now I need to find a way to do a multi find and replace on all of the data. The way that ive done this in the past is with the code below. Problem is I am working with a much larger dataset than normal. The sheet has around 30,000 rows and once Delimited and the emails are stacked, its around 130,000 rows. The code below does work but took around 40 minutes to replace all 130,000. I did not dedupe this list (probably should have).

Does anyone know of a better way to code a faster multi find and replace when the values are always changing? Or maybe someone can think of a better way to accomplish this task?

<code class="vb keyword">Sub</code> <code class="vb plain">MultiFindNReplace()</code>
<code class="vb comments">'Update 20140722</code>
<code class="vb keyword">Dim</code> <code class="vb plain">Rng </code><code class="vb keyword">As</code> <code class="vb plain">Range</code>
<code class="vb keyword">Dim</code> <code class="vb plain">InputRng </code><code class="vb keyword">As</code> <code class="vb plain">Range, ReplaceRng </code><code class="vb keyword">As</code> <code class="vb plain">Range</code>
<code class="vb plain">xTitleId = </code><code class="vb string">"KutoolsforExcel"</code>
<code class="vb keyword">Set</code> <code class="vb plain">InputRng = Application.Selection</code>
<code class="vb keyword">Set</code> <code class="vb plain">InputRng = Application.InputBox(</code><code class="vb string">"Original Range "</code><code class="vb plain">, xTitleId, InputRng.Address, Type:=8)</code>
<code class="vb keyword">Set</code> <code class="vb plain">ReplaceRng = Application.InputBox(</code><code class="vb string">"Replace Range :"</code><code class="vb plain">, xTitleId, Type:=8)</code>
<code class="vb plain">Application.ScreenUpdating = </code><code class="vb keyword">False</code>
<code class="vb keyword">For</code> <code class="vb keyword">Each</code> <code class="vb plain">Rng </code><code class="vb keyword">In</code> <code class="vb plain">ReplaceRng.Columns(1).Cells</code>
<code class="vb spaces">    </code><code class="vb plain">InputRng.Replace what:=Rng.Value, replacement:=Rng.Offset(0, 1).Value</code>
<code class="vb keyword">Next</code>
<code class="vb plain">Application.ScreenUpdating = </code><code class="vb keyword">True</code>
<code class="vb keyword">End</code> <code class="vb keyword">Sub</code>