Please help to modify my code

[Ethen5155]

Hello and hope all is well.


please i'm just need a little small help to improve this code.


there is file attached i use to color specific words is first tab column (A)


23877






using a words list at second tab column (A)




23878




then add those colored words on first tab column (C) with followed colon (:)


23879






The final touch which i need to help me about is to insert each definition from second tab column (B) after each colored word on first tab column (C)




23880






i have attached the file that contains code, and i hope if someone can help about that and keeping in mind two points:


1- this code excludes (skips) repeated words in column (A) first tab if found and doesn't copy it to column (C) and i want to disable this feature. for ex. if found word (Test 1) in cell A3,A7,A10 it will copy it just one time at C3 but what i want is to copy it in C3,C7,C10




2- second point if there are two values in the same cell column (A) like (Test 1) and (Test 2) i want them to be copied to column (C) even if they copied before.




P.S: final result in column (C) if is colored like screenshot it will be very highly appreciated.


Cross Posted link : here (https://www.excelforum.com/excel-programming-vba-macros/1267814-please-help-to-modify-my-code.html)

Thanks in Advance dears.


cheers

[Ethen5155]

Solved here (https://www.excelforum.com/excel-programming-vba-macros/1267814-copy-text-from-tab-to-another.html)



Sub Ethen5155() Dim Cl As Range
Dim Kws As Worksheet, Dws As Worksheet
Dim Ky As Variant
Dim i As Long

Set Kws = Sheets("Terms Keywords")
Set Dws = Sheets("Sheet1")

With CreateObject("Scripting.dictionary")
For Each Cl In Kws.Range("A2", Kws.Range("A" & Rows.Count).End(xlUp))
If Cl.Value <> "" Then .Item(Cl.Value) = Cl.Value & ":" & Cl.Offset(, 1).Value
Next Cl
For Each Cl In Dws.Range("A2", Dws.Range("A" & Rows.Count).End(xlUp))
For Each Ky In .keys
i = InStr(LCase(Cl), LCase(Ky))
If i > 0 Then
Cl.Characters(i, Len(Ky)).Font.Color = 500000
If Cl.Offset(, 2) = "" Then
Cl.Offset(, 2).Value = .Item(Ky)
Else
Cl.Offset(, 2).Value = Cl.Offset(, 2) & vbLf & .Item(Ky)
End If
End If
Next Ky
Next Cl End With