Remove Identical words

[ranjank3010]

Hi,

Complie Error: For without next....

Please review the below error, after a removing identical rows (Range is from 4th row & 2nd colum) then calculate the wc for column 3.

Range is from 4th row & 3rd column and display a msg as "WC"

Posted in MS OFFICE FORUM: https://www.msofficeforums.com/word-tables/48469-removing-identical-rows.html#post165800

Please review the below one and do the needful.

Public Sub DeleteDuplicatesCol3()

  Dim xTable As Table, xRow As Range, xStr As String, xDic As Object
  Dim I As Long, J As Long, KK As Long, xNum As Long, iRow As Long, iRows As Long
  Dim aRng As Range, cRng As Range, lWords As Long, lRows As Long, aCell As Cell
  Dim nWordsCount As Long
  Dim nCharCount As Long

  'Application.ScreenUpdating = False
  Set xDic = CreateObject("Scripting.Dictionary")
  If Selection.Tables.Count = 0 Then
    MsgBox "Macro must be run when a table is selected"
    Exit Sub
  Else
    Set xTable = Selection.Tables(1)
    iRows = xTable.Rows.Count
    For I = iRows To 4 Step -1
      Set aRng = xTable.Cell(I, 2).Range
      For iRow = 4 To I - 1
        Set cRng = xTable.Cell(iRow, 2).Range
        If aRng.Text = cRng.Text Then
          xTable.Rows(I).Delete
          lRows = lRows + 1
          Exit For
        End If
      Next iRow
    Next I
  End If
 
  Set aRng = ActiveDocument.Range(xTable.Rows(4).Range.Start, xTable.Range.End)
 
For Each aCell In aRng.Cells

 If aCell.ColumnIndex = 3 Then

nWordsCount = aRng.ComputeStatistics(wdStatisticWords)
nCharCount = aRng.ComputeStatistics(wdStatisticCharacters)
 
    Application.ScreenUpdating = True

    MsgBox "Word count in column 3: " & "The entire doc contains: " & vbCrLf & nWordsCount & " words and" & vbCrLf & _
           nCharCount & " characters without spaces", , "Word Count"

  End If

 
  End Sub