0

Can anyone help bring me to the finish line with this Do While Loop?

Essentially, I've got a column in my spreadsheet that is populated with of sentences. I'm trying to evaluate every word in each cell to determine if it contains a keyword existing as an element in the keywords Array. If so, the included keywords are to be listed in the corresponding cells on the column "Keywords."

However, when keywords were mentioned twice my sub routine lists them twice, eg. "keyword, keyword." All I need to do is remove the duplicate keywords from my output

Here is what I have thus far for this somewhat expansive sub routine.

Private Sub brand_names() 'inserts column with product brand mentioned in SalesForce Case

Dim ws As Worksheet
Dim last_col As Integer
Dim PuncChars, products, x, InArray As Variant
Dim i As Long, r As Long, q As Long
Dim txt, inputstring As String


keywords = Array("KEYWORDONE","KEYWORDTWO","KEYWORDTHREE")
PuncChars = Array(".", ",", ";", ":", "'", "!", "#", _
        "$", "%", "&", "(", ")", " - ", "_", "--", "+", _
        "=", "~", "/", "\", "{", "}", "[", "]", """", "?", "*", "#")

Set ws = ThisWorkbook.Worksheets("Applicable Spreadsheet")

last_col = ws.Cells(1, Columns.Count).End(xlToLeft).Column + 1

ws.Cells(1, last_col).Value = "Keywords"

On Error GoTo Endproc

Application.ScreenUpdating = False

r = 2

    Do While Not Cells(r, 12) = ""
'       coverts to UPPERCASE
        txt = UCase(Cells(r, 12))
'       Remove punctuation
        For i = 0 To UBound(PuncChars)
            txt = Replace(txt, PuncChars(i), " ")
        Next i
'       Remove excess spaces
        txt = WorksheetFunction.Trim(txt)
'       Extract the words
        x = Split(txt)
        'append words to array
        For i = 0 To UBound(x)
            For z = 0 To UBound(keywords)
            If x(i) = keywords(z) Then
            ws.Cells(r, last_col).Value = ws.Cells(r, last_col).Value & x(i) & ","
            End If
            Next z
        Next i
        'code to remove duplicates would go here
        r = r + 1
    Loop
    
'need to remove duplciates from mentioned brands and add comma between each one
Endproc:
Application.ScreenUpdating = True
Exit Sub
MsgBox ("error")
End Sub

I'm trying to add a line to my Do loop that will reduce the duplicate keywords in the output cells, so that rather than "KEYWORDONE,KEYWORDONE" it just says "KEYWORDONE"

Does anyone have an idea how I can do this from within the Do loop?

Possdawgers
  • 93
  • 6
  • If you reduce the array `x` to only the unique items that should do it. See eg. https://stackoverflow.com/questions/3017852/vba-get-unique-values-from-array/3017973 – Tim Williams Jan 11 '22 at 03:48
  • If you aren't familiar with regular expressions, I strongly recommend looking at [this link on SO for VBA Regex.](https://stackoverflow.com/questions/25102372/how-to-use-enable-regexp-object-regular-expression-using-vba-macro-in-word) I think you should look at `.Test` with regex for the keywords, ignoring case and the punctuation. If the keyword exists with `.Test`, you can just add it once and move on to the next keyword. – ScottyJ Jan 11 '22 at 04:00
  • @Tim Williams, would you suggest doing this immediately after the split function in the script? – Possdawgers Jan 11 '22 at 04:25
  • Yes that seems like the place for it – Tim Williams Jan 11 '22 at 05:27
  • @wackojacko1997, this is actually a good suggestion and something i've been meaning to look into. – Possdawgers Jan 14 '22 at 00:41
  • I think Regex in VBA is a bit clunky to use (I'm currently studying / using R, which I have found to be much easier for lots of things I used to do in Excel), but you come across a fair number of use cases for it, and if you've never used Regex before, it's a bit mind-blowing how useful it is for parsing text. Probably somewhere there's "Top 10 Topics for New Programmers" and I would put Regex as a topic in the list. – ScottyJ Jan 14 '22 at 16:09

0 Answers0