#1
|
|||
|
|||
Removing Identical Rows
This was my regular task, which was taking more time to manually process this, I don’t know whether it can be possible or not to automate this task by VBA, I get a hope because you work like a pro and make all the things possible....
If anything, wrong or not seems realistic, please excuse me.... Am a basic learner and I tried from my side by recording a macro and worked on that macro, but it doesn’t seems meaningful for me and I tried to copy from other sites but not worked for me.... Task: In a document am having word table, having three columns and n no of rows. I want to delete a duplicate line or words in a row, range is start from 4th row and 2nd column to end of the table. Then I want to calculate a word count, range is from 4th row, 3rd column to last row of the table and after running a macro it will displays a popup message as “Total word count: 73” Format: .docx & .rtf Remove duplicate rows is not a case sensitive. Output document should be open and displays a word count message and output file will be saved in a same path with a same filename adding “_WC” to the existing file name. Output document format either .docx or .rtf Actual opened document should be closed, and output document should be opened after a running a macro. Please find a attachment for better understanding. I tried a below code from other sources but not worked, it might be helpful to others, so I pasted here. Code:
Public Sub DeleteDuplicateRows() Dim xTable As Table Dim xRow As Range Dim xStr As String Dim xDic As Object Dim I, J, KK, xNum As Long If ActiveDocument.Tables.Count = 0 Then MsgBox "This document does not have table(s)." Exit Sub End If Application.ScreenUpdating = False Set xDic = CreateObject("Scripting.Dictionary") If Selection.Information(wdWithInTable) Then Set xTable = Selection.Tables(1) For I = xTable.Rows.Count To 1 Step -1 Set xRow = xTable.Rows(I).Range xStr = UCase(xRow.Text) xNum = -1 If xDic.Exists(xStr) Then ' xTable.Rows(I).Delete For J = xTable.Rows.Count To 1 Step -1 If (xStr = xTable.Rows(J).Range.Text) And (J <> I) Then xNum = xNum + 1 xTable.Rows(J).Delete End If Next I = I - xNum Else xDic.Add xStr, I End If Next Else For I = 1 To ActiveDocument.Tables.Count Set xTable = ActiveDocument.Tables(I) xNum = -1 xDic.RemoveAll For J = xTable.Rows.Count To 1 Step -1 Set xRow = xTable.Rows(J).Range xStr = UCase(xRow.Text) xNum = -1 If xDic.Exists(xStr) Then ' xTable.Rows(I).Delete For KK = xTable.Rows.Count To 1 Step -1 If (xStr = xTable.Rows(KK).Range.Text) And (KK <> J) Then xNum = xNum + 1 xTable.Rows(KK).Delete End If Next J = J - xNum Else xDic.Add xStr, J End If Next Next End If Application.ScreenUpdating = True End Sub |
#2
|
||||
|
||||
Try this version for the duplicate row deletion
Code:
Public Sub DeleteDuplicateRows2() 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 '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 3 Step -1 Set aRng = xTable.Rows(I).Range aRng.Start = aRng.Cells(2).Range.Start For iRow = 3 To I - 1 Set cRng = xTable.Rows(iRow).Range cRng.Start = cRng.Cells(2).Range.Start If aRng.Text = cRng.Text Then xTable.Rows(I).Delete Exit For End If Next iRow Next I End If Application.ScreenUpdating = True End Sub
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#3
|
|||
|
|||
Thanks for the prompt response...
Its not working well, only one duplicate row was deleting if there are more than one it was not get deleting, please review the code once... Is it possible to ammend the word count for this table or is it required to have a seperate macro for the WC Stats to the correct column (i.e. range from 4th row 3rd column to end of the table) and displays a message as WC = 73 (Only Word count stats is enough document was not required) |
#4
|
||||
|
||||
Do you only want to count words in the second and third column? And is the count only after the duplicate rows have been removed?
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#5
|
|||
|
|||
First I want to removed the duplicate rows (range from 4th row n 2 column to end of the table)
Then I want to know only word count of correct column (range from 4th row, 3rd column to end of table) Just display msg of word count is enough or any other option is available to know wc if we can't integrate the wc into this macro. separate macro also we can try to know the wc rather than doing manually. Thanks a lot for your prompt responses and great work.... |
#6
|
||||
|
||||
Does this work? I've changed it to only look at column 2 for deleting duplicates and only look at column 3 for your word count. Is that right?
Code:
Public Sub DeleteDuplicatesCol2() 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 '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 lWords = lWords + aCell.Range.Words.Count - 1 Next aCell Application.ScreenUpdating = True MsgBox "Word count in column 3: " & lWords End Sub
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#7
|
|||
|
|||
Quote:
WC should be calculated after deleting a duplicate rows and range for WC is from 4th row & 3rd Column, Please find the above ZIP attachment for sample doc. Through VBA WC is 86 & Manully WC is 73. Its work very closely... Plesee find the below link.... https://www.linkpicture.com/q/Macro_...-Duplicate.jpg https://www.linkpicture.com/q/Manully_1.jpg |
#8
|
|||
|
|||
Hi,
Complie Error: For without next.... Please review the below error, after a removing identical rows then calculate the wc for column 3. Range is from 4th row & 3rd column and display a msg as "WC" Code:
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 Last edited by ranjan; 02-14-2022 at 10:58 PM. Reason: Code reviewed & getting compile error |
#9
|
||||
|
||||
Your second yellow line opens a For loop but you didn't include a Next aCell at the end.
Do a manual count of the words being returned by your code. If your code is returning an additional number of words that match the number of cells then it is likely you are also counting the end of cell markers as a word.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
Tags |
delete, identical |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Removing rows when mail merging | Richystab | Mail Merge | 3 | 12-07-2020 03:05 AM |
Identical computers | MeCasa | Office | 0 | 09-23-2019 03:43 PM |
Removing duplicate rows when identical value in a column | ballpoint | Excel | 1 | 01-05-2018 08:54 AM |
how to delete every blank and non-numeric rows without removing the header | enuff | Excel | 3 | 08-24-2017 05:56 AM |
How to find an identical sentences? | Bill K | Word | 1 | 12-03-2015 12:16 AM |