Optimization VBA text search
<p>I created a VBA code for text analysis, but I encountered a problem at run time. 
I just found on Google an advice on using excel built in function, but it did not improve the run time.</p>

<p>Here is the problem for which I use VBA.
I've got a list of ~30k cells containing text (one or two sentences on average) and a list of 1k keywords, all of them having a numeric score.
For every of the 30k cells, I want to see which of the keywords the cell contains, and calculate the sum of the scores of the keywords found.</p>

<p>Here is my way of approaching the problem in a nutshell right now :</p>

<ul>
<li><p>Loop on the 30k text cells</p></li>
<li><p>Loop on the keywords</p></li>
<li><p>Check if the keyword is in the text cell, if yes, add the score of the keyword </p></li>
</ul>

<p>I also tried using the search built in function : </p>

<ul>
<li><p>Loop on the keywords</p></li>
<li><p>Search the keywords on the entire sheet containing the 30k text cells</p></li>
<li><p>When the keyword is found, add the score on the corresponding cell.</p></li>
</ul>

<p>There was no significant change in run time.</p>

<p>Below you can find my code for the first approach: </p>

<pre><code>'Loop on all the 30k text cells
For i = 2 To last_textcell

    'loop on the number of different category of scores, setting intial scores to zero.
    For k = 1 To nb_score - 1
        Score(k) = 0
    Next k

    j = 2

    'loop on the 1k keywords        
    Do While j &lt; last_keywords

            !search if the keyword is in the text cell
            If UCase(Sheets("DATA").Range("V" &amp; i).Value) Like "*" &amp; UCase(Sheets("Keywords").Range("A" &amp; j).Value) &amp; "*" Then

                'if the keyword is found, add the score of the keyword to the previous score
                For l = 1 To nb_score - 1
                    Score(l) = Score(l) + Sheets("Keywords").Range("B" &amp; j).Offset(0, l - 1).Value
                Next l

            End If

            j = j + 1

    Loop

    'paste the score 
    For k = 1 To nb_categ - 1
        Sheets("DATA").Range("CO" &amp; i).Offset(0, k - 1).Value = Score(k)
    Next k


Next i
</code></pre>

<p>Do you have any tips on how to improve the performance? </p>

<p>Thank you very much!</p>