Please need some help to edit my macro (Copy colored words)

[Ethen5155]

Hello All,


kindly please i need some help to edit my attached macro to met the requirements i need.


there is xlsm file attached (Terms Highlight.xlsm)


in second tab (Terms Keywords) as shown below i put terms keywords as shown below


23433


and in the first tab (Target) i put the all segments which contain words that i need to highlight with the help of the second tab i mentioned above


23434


and i success at that but there are 3 issues i couldn't fix or reach to:


1- i have to put all words in second tab (Terms Keywords) in lower case first and if i didn't it won't color any matching word in the first tab (Target).




2- i need to make the macro skip or exclude the repeated words, for ex. if it found "School" at the first cell and this word exists in the 4th cell then skip it and just color the one in the first cell




3- (The most important edit i want)i need to extract those colored non repeated words to column (C) and put colon (:) after it as shown below to be translated later to another language, and this feature should work well with the cell that contains about three or four extracted words.


23435


Many thanks in advance, and any help will be highly appreciated


Cheers




Post-Link : here (https://www.excelforum.com/excel-programming-vba-macros/1256984-please-need-some-help-to-edit-my-macro-copy-colored-words.html#post5029375)

[Ethen5155]

#Solved by AlphaFrog (https://www.excelforum.com/members/235459.html)




Sub TermsHighlight()
''/// This Macro created by: Ethen on 24/3/2018

Dim lr&, i&, j&, MW, c$
MW = Application.Transpose(Range("_k"))
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lr
c = ""
For j = 1 To UBound(MW)
If MW(j) <> "" Then
If InStr(LCase(Cells(i, 1)), LCase(MW(j))) > 0 Then
Cells(i, 1).Characters(Start:=InStr(LCase(Cells(i, 1)), LCase(MW(j))), Length:=Len(MW(j))).Font.Color = 500000
c = c & MW(j) & ":" & vbLf
MW(j) = ""
End If
End If
Next j
If c <> "" Then Cells(i, "C").Value = Left(c, Len(c) - 1)
Next i End Sub

[Ethen5155]

not solved yet!!

could you please check attached file as it doesn't work well for the rest of cells

it only give about 399 record and it it supposed to extract more than than a lot, do you think it won't work for the huge number of cells?!!

also i found it skips a lot of terms not highlighted or extracted!!

[Ethen5155]

#Solved