Excel VBA - Remove keywords variations

[efka0193]

Hello,

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!

 

[ask2tsp]

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

 

[efka0193]

Hello,

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.

 

[ask2tsp]

Maybe some invisible difference between the two lines? Check for extra space at the end.

 

[efka0193]

I did checked.

It's the same even if i removed "+"

2016-11-30_1105

 

[ask2tsp]

That's weird. I changed my test sheet (moved list to A1 and removed the +'s) got these results

Excel Workbook
	A	B	C	D
1	excel scripts for free	*	*	excel scripts for free
2	i love excel vba	*	*	i love excel vba
3	for free excel scripts	*	*	please help me
4	scripts excel for free	*	*	*
5	i love vba excel	*	*	*
6	please help me	*	*	*
Blad1

Can you upload your workbook and publish the link so I can examine?

 

[efka0193]

Here is the file.

https://we.tl/U7KKhYW1Nz

Thanks

 

[ask2tsp]

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

 

[efka0193]

Sorry, i'm not sure i understand what you said.

What should i change.

And i'm not sure what is linefeed.

 

[ask2tsp]

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!)