Repository files navigation

This VBA script removes duplicate words within cell contents in a specified range of columns in an Excel worksheet. In this example, the script processes columns D to AD.

The script iterates through each cell in the specified range of columns (D to AD), splits the cell content into individual words, and uses aCollection to identify and keep only unique words. The cell content is then updated with the unique words.

1. Open your Excel workbook.
2. PressAlt + F11 to open the VBA editor.
3. Insert a new module by selectingInsert > Module.
4. Copy and paste the VBA code into the module.
5. Adjust the sheet name if necessary (Sheet1).
6. Run the script by pressingF5 or by selectingRun > Run Sub/UserForm.

SubRemoveDuplicateWords()Dim cellAsRangeDim wsAsWorksheetDim iAsIntegerDim words()AsStringDim uniqueWordsAsStringDim wordDictAsCollectionDim wordAsVariantDim colAsIntegerSet ws = ThisWorkbook.Sheets("Sheet1")' Change this to your sheet nameFor col =4To30' From column D (4) to column AD (30)For Each cellIn ws.Columns(col).SpecialCells(xlCellTypeConstants, xlTextValues)            words = Split(cell.Value," ")Set wordDict =NewCollection            uniqueWords =""On ErrorResume NextFor i = LBound(words)To UBound(words)                wordDict.Add words(i), CStr(words(i))If Err.Number =0Then                    uniqueWords = uniqueWords & words(i) &" "End If                Err.ClearNext iOn ErrorGoTo0            cell.Value = Trim(uniqueWords)Set wordDict =NothingNext cellNext colEnd Sub

If you have any suggestions or improvements, feel free to create a pull request or open an issue.

This project is licensed under the MIT License - see theLICENSE file for details.