Excel VBA - Remove keywords variations


New Member
Nov 25, 2016

I would like to ask you help with one problem i have.

I need to remove same keywords in range with different words variations.

For example i have list of keywords:

+excel +scripts +for +free
+i +love +excel +vba
+for +free +excel +scripts
+scripts +excel +for +free
+i +love +vba +excel
+please +help +me

Results should be:

+excel +scripts +for +free
+i +love +excel +vba
+please +help +me


Thank you very much!

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
paste this in a general module
Option Explicit

Sub removeDupKeywords()

'every cel in source contains one or more keywords _
 written as: +keyw1[[ +keyw2][ +kew3]]...
'following lines with same keyword(s), any order, are removed

    Dim source  As Range    'the range to examine
    Dim dest    As Range    'topleft of the destination where the results go
    Dim cel     As Range
    Dim i       As Long
    Dim j       As Long
    Dim k       As Long
    Dim n       As Long
    Dim ubi     As Long
    Dim var()   As Variant
    Dim found   As Boolean
    Dim fcount  As Long
    Set source = Range("B3:B" & Range("B3").End(xlDown).Row)    '<-- edit
    Set dest = Range("D3")  '<-- edit
    ReDim var(source.Rows.Count)
    For Each cel In source
        var(n) = Split(cel, " ")
        found = False
        If n > 0 Then   'skip match for first entry
            'match with keywords loaded sofar
            For i = 0 To n - 1  'try entries one by one
                ubi = UBound(var(i))
                fcount = 0  'counts matches found
                If ubi = UBound(var(n)) Then 'same number of keywords?
                    For j = 0 To ubi    'try every keyword
                        For k = 0 To ubi 'try every keyword new entry
                            If var(i)(j) = var(n)(k) Then
                                fcount = fcount + 1
                                Exit For
                            End If
                        Next k
                    Next j
                End If
                found = (fcount = ubi + 1) 'all keywords found?
                If found Then Exit For 'don't bother checking the rest
            Next i
        End If
        If Not found Then
            'new unique set of keywords
            If n = UBound(var) Then
                ReDim Preserve var(UBound(var) * 1.5)
            End If
            n = n + 1
        End If
    Next cel
    'publish results to destination
    Range(dest, dest.End(xlDown)).Clear
    For i = 0 To n - 1
        dest.Offset(i).Value = Join(var(i), " ")
    Next i
End Sub

edit the '<-- edit' lines to your situation
Upvote 0

Thank you very much for an answer.

I have tested this script and it worked almost perfectly :)

I have tested with same keywords list.

+excel +scripts +for +free
+i +love +excel +vba
+for +free +excel +scripts
+scripts +excel +for +free
+i +love +vba +excel
+please +help +me

And the result was.

+excel +scripts +for +free
+i +love +excel +vba
+i +love +vba +excel
+please +help +me

Maybe you know why these two keywords stayed?

Thank you very much again.
Upvote 0
Maybe some invisible difference between the two lines? Check for extra space at the end.
Upvote 0
That's weird. I changed my test sheet (moved list to A1 and removed the +'s) got these results
Excel Workbook
1excel scripts for free**excel scripts for free
2i love excel vba**i love excel vba
3for free excel scripts**please help me
4scripts excel for free***
5i love vba excel***
6please help me***

Can you upload your workbook and publish the link so I can examine?
Upvote 0
i love excel vba linefeed between excel and vba
i love vba excel linefeed between love and vba and between vba and excel

change the lf to space and it's ok
Upvote 0
Sorry, i'm not sure i understand what you said.

What should i change.

And i'm not sure what is linefeed.
Upvote 0
linefeed (LF code 10) is a so-called nonprintable character. Non printable because you don't see anything printed. It is one of the 'whitespace' characters, together with carriage return (CR code 13), tab (TAB code 9) and a few more; you might want to take a look at Ascii Table - ASCII character codes and html, octal, hex and decimal chart conversion. In fact the first 32 codes (0-31) are known as control characters because they control things like printer head/paper movement and data communication protocols.

Edit cell A2, i love excel vba
set the cursor after the word excel, press Delete, type a space,press Enter.
You just replaced whatever was there with a space.

Do the same for cell A5 (2 places!)
Upvote 0

Forum statistics

Latest member

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back