remove repeated words with " macro " or " wild cards " in texts with parentheses and commas

[jocke321]

(sorry for my bad english , but I'm tired and have already searched for it and asked the question on another forum of my language . so I used Google Translate)

Me:
Hi, I want to remove repeated words with " macro " or " wild cards " in texts such as :

Muffin Basic NY (wheat flour,margarine(vegetable fat(palm,rapeseed, coconut,palm kernel),water,emulsifier(E471 of vegetable fat),salt,aromas, antioxidants(E330),coloring(E160a)),salt,yeast,whe at flour,dextrose,canola oil , wheat flour , sugar , wheat flour, emulsifiers E472e , flour treatment agent E300, sugar, water )

As you can see, " wheat flour " several times and the text becomes too large , i have to make the text as short as possible and has 100+ recipes that I'll have to do , and do it all manually will take to long time

Sorry if I posted in the wrong forum or if there is already a thread

1:
How difficult is it to google ?


[broken link deleted]

me:
It does not work so well, it removes inter alia, parentheses, and commas . and you must have space between each word and character otherwise it will be included in the word so the word " you ", " you, " and " (you "
are three different words ( pretty easy to fix, though), then it will be to much cut and paste ,that was my backup plan but figured check if I could fix everything in ms word with the " Macros ", " Find & Replace " and " Wild Cards "

but thanks anyway

What I have come up with so far is to search & replace and remove all brackets, commas and dots and then run it through [broken link deleted]. But it takes a long time with all copy o paste and the text can be a bit incomprehensible that I have to correct afterwards and takes lot of time that I have not .

But you should be able to make a macros that are like the website though it skips parentheses , comma and dots. Because then I could have run the spacing between all characters with "search and replace" , removing repetitive ingredients and remove the spaces again ..

Grateful for answers and any suggestions you can give


I only included the important answers.
I appreciate all the suggestions and answers I get. Thanks in advance

[macropod]

Try the following macro:

Sub Demo()
Application.ScreenUpdating = False
Dim Para As Paragraph, i As Long, j As Long
Dim StrTxt As String, StrTmp As String, StrFnd As String
With ActiveDocument
  With .Range.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Format = False
    .MatchCase = False
    .Wrap = wdFindContinue
    .MatchWildcards = False
    .Text = " )"
    .Replacement.Text = ")"
    .Execute Replace:=wdReplaceAll
    .Text = "( "
    .Replacement.Text = "("
    .Execute Replace:=wdReplaceAll
    .Text = " ,"
    .Replacement.Text = ","
    .Execute Replace:=wdReplaceAll
    .Text = ", "
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
    .Text = ",{2,}"
    .Execute Replace:=wdReplaceAll
    .Text = "^13{2,}"
    .Replacement.Text = "^p"
    .Execute Replace:=wdReplaceAll
  End With
  For Each Para In .Paragraphs
    StrTxt = Para.Range.Text: StrFnd = ""
    StrTxt = Replace(Replace(Replace(StrTxt, "(", ","), ")", ","), vbCr, "")
    Do While InStr(StrTxt, ", ") > 0
      StrTxt = Replace(StrTxt, ", ", ",")
    Loop
    Do While InStr(StrTxt, " ,") > 0
      StrTxt = Replace(StrTxt, " ,", ",")
    Loop
    Do While InStr(StrTxt, ",,") > 0
      StrTxt = Replace(StrTxt, ",,", ",")
    Loop
    For i = 1 To UBound(Split(StrTxt, ","))
      j = Len(StrTxt)
      StrTmp = Split(StrTxt, ",")(i)
      If StrTmp <> "" Then
        StrTxt = Replace(StrTxt, StrTmp, "")
        If (j - Len(StrTxt)) > Len(StrTmp) Then StrFnd = StrFnd & "," & StrTmp
      End If
    Next
    If StrFnd <> "" Then
      For i = 1 To UBound(Split(StrFnd, ","))
        StrTmp = Split(StrFnd, ",")(i)
        With Para.Range
          .Start = .Start + InStr(.Text, StrTmp) + Len(StrTmp)
          With .Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Format = False
            .Forward = True
            .MatchCase = False
            .Wrap = wdFindStop
            .MatchWholeWord = True
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Text = StrTmp & ","
            .Replacement.Text = ""
            .Execute Replace:=wdReplaceAll
            .Text = StrTmp & "^p"
            .Replacement.Text = "^p"
            .Execute Replace:=wdReplaceAll
          End With
        End With
      Next
    End If
  Next
  With .Range.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Format = False
    .MatchCase = False
    .Wrap = wdFindContinue
    .MatchWildcards = True
    .Text = " ,"
    .Replacement.Text = ","
    .Execute Replace:=wdReplaceAll
    .Text = ", "
    .Execute Replace:=wdReplaceAll
    .Text = ",{2,}"
    .Execute Replace:=wdReplaceAll
    .Text = ","
    .Replacement.Text = ", "
    .Execute Replace:=wdReplaceAll
  End With
End With
Application.ScreenUpdating = True
End Sub

Note: Three times in the code, you will see {2,}. Depending on your system's regional settings you may need to change these to {2;}.

The code also does some tidying-up of your text.

[jocke321]

Thank you so much, you saved me from a lot of work and it worked perfectly without any problems, have encountered a few with this task when I tried to fix it myself, but at least i learned alot.
thanks again, you are a lifesaver, I am in your debt