Consulting

Results 1 to 4 of 4

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

  1. #1

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

    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


    2.jpg


    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


    3.jpg


    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.


    1.jpg


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


    Cheers




    Post-Link : here
    Attached Files Attached Files

  2. #2
    #Solved by AlphaFrog



    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 EndSub

  3. #3
    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!!


    Attached Files Attached Files

  4. #4
    #Solved

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •