How to remove duplication in specific table cells?

[thedark123]

I need to do a macro that will remove the extra Test Case ID behind, the ID in brackets, how to modify my current code to remove that code?

There are multiple tables like this in a single word document.
I need to do a loop to remove all duplications like this



For j = 0 To tcount
ActiveDocument.Tables(j).Select
With Selection.Find
.ClearFormatting
.Text = "Test Case ID:"
.Format = True
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Forward = True
Do While .Execute(Forward:=True, Format:=True) = True
With .Parent
testid(j) = ActiveDocument.Tables(j).Cell(1, 2).Range.Text
rcount(j) = ActiveDocument.Tables(j).Rows.Count - 4
End With
Loop
End With
Next j
ActiveDocument.Close SaveChanges:=wdDoSaveChanges

http://i6.photobucket.com/albums/y226/thedark123/testcaseid.png

[mdmackillop]

Try this modification


.Forward = True
.Execute
With .Parent
tmp = ActiveDocument.Tables(j).Cell(1, 2).Range.Text
pos1 = InStr(tmp, "(")
ActiveDocument.Tables(j).Cell(1, 2).Range.Text = Left(tmp, pos1 - 1)
End With
End With

[thedark123]

Got a change of plan from my supervisor, eh mdmackillop can i do this instead?

http://i6.photobucket.com/albums/y226/thedark123/tablelist.gif

Is there anyway to check through all table cells in the file that contains

System displays ******** (********)
* denotes examples wildcard

possisble to remove all things contain in the () or anything that come after the underline

so that all i run this macro

it will become like this for example:
System displays Blacklist Details

same for everything

[mdmackillop]

You can adapt my previous code to cyle through a list of search parameters, deleting text following it within a table. If the text is not in a table, you would need to determine the position of the opening and closing brackets and Characters.Delete to remove these. Alternatively, you need one of our RegExp experts to assist here.
Regards
MD

[thedark123]

Can do it with a example will be good. =)
Cause i need this script urgently but i am not quite familiar with the positioning....

[thedark123]

i replaced the coding with mdmackillop already does not seems to work:

maybe i did wrongly somewhere


Sub CommandButton1_Click()
' Example Macro to list the files contained in a folder.
Dim x As String, MyName As String
Dim i As Integer
Dim Response As Integer, TotalFiles As Integer
Dim counter As Integer
On Error Resume Next
Folder:
' Prompt the user for the folder to list.
x = InputBox(Prompt:="What folder do you want to list?" & vbCr & vbCr _
& "For example: C:\My Documents", _
Default:=Options.DefaultFilePath(wdDocumentsPath))
If x = "" Or x = " " Then
If MsgBox("Either you did not type a folder name correctly" _
& vbCr & "or you clicked Cancel. Do you want to quit?" _
& vbCr & vbCr & _
"If you want to type a folder name, click No." & vbCr & _
"If you want to quit, click Yes.", vbYesNo) = vbYes Then
Exit Sub
Else
GoTo Folder
End If
End If
' Test if folder exists.
If Dir(x, vbDirectory) = "" Then
MsgBox "The folder does not exist. Please try again."
GoTo Folder
End If
' Search the specified folder for files
' and type the listing in the document.
With Application.FileSearch
.NewSearch
.FileType = msoFileTypeOfficeFiles
' Change the .FileType to the type of files you are looking for;
' for example, the following line finds all files:
' .FileType = msoFileTypeAllFiles
.LookIn = x
.Execute
TotalFiles = .FoundFiles.Count
If TotalFiles = 0 Then
MsgBox ("There are no files in the folder!" & _
"Please type another folder to list.")
GoTo Folder
End If
' Stop the screen flickering
Application.ScreenUpdating = False
' Initialise all variables for extra feature
Dim tcount As Integer
Dim y As Integer
Dim testid()
Dim rcount()
tcount = ActiveDocument.Tables.Count
y = 0
ReDim testid(tcount)
ReDim rcount(tcount)
For j = 0 To tcount
ActiveDocument.Tables(j).Select
With Selection.Find
.ClearFormatting
.Text = "Test Case ID:"
.Format = True
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Forward = True
Do While .Execute(Forward:=True, Format:=True) = True
' With .Parent
' testid(j) = ActiveDocument.Tables(j).Cell(1, 2).Range.Text
' rcount(j) = ActiveDocument.Tables(j).Rows.Count - 4
' End With
With .Parent
tmp = ActiveDocument.Tables(j).Cell(1, 2).Range.Text
pos1 = InStr(tmp, "(")
ActiveDocument.Tables(j).Cell(1, 2).Range.Text = Left(tmp, pos1 - 1)
End With
Loop
End With
Next j
ActiveDocument.Close SaveChanges:=wdDoSaveChanges
Application.ScreenUpdating = True
End With
If MsgBox("Do you want to list another folder?", vbYesNo) = vbYes Then
GoTo Folder
End If
End Sub

[thedark123]

need some help here

[fumei]

I wish you would post a little better. You don't explain enough.

1. WHAT is the problem? Describe exactly.
2. WHAT is actually happening. Describe exactly.

I read your code and I have no real solid idea of what is actually happening.

A further suggestion is some better commenting in your code.
' Initialise all variables for extra featureis a totally useless comment. "extra feature" says nothing at all. Why is it "extra"? And....what IS it?

As you are not very clear
possisble to remove all things contain in the () or anything that come after the underlineSo....which is it????? In the (), or everything after the underline??? Who knows.

However, if you really want to remove everything after the underline, for each cell in the table - and assuming there is NO other paragraph mark in the cell, and assuming your graphic of the table is correct and you really want to remove the ( what ever what ever ) - then...well...just do that.


Sub BracketsGone()
Dim r As Word.Range
Dim aCell As Word.Cell
For Each aCell In ActiveDocument.Tables(1).Range.Cells
Set r = aCell.Range
With r.Find
.ClearFormatting
.Text = "("
.Execute
r.Collapse Direction:=wdCollapseStart
r.MoveEndUntil Cset:=vbCrLf, Count:=wdForward
r.Delete
End With
Set r = Nothing
Next
End Subwill remove everything from the "(" to the end of the cell text.

However, since your posts are rather confusing - is this about "Test Case ID" - or is it about everything after the underline...I am not sure if this will help.

Oh...and please use the underscore character in your code. it would help a lot. Thanks.

[thedark123]

Is something wrong with it?



Sub CommandButton1_Click()
' Example Macro to list the files contained in a folder.
Dim x As String, MyName As String
Dim i As Integer
Dim Response As Integer, TotalFiles As Integer
Dim counter As Integer
On Error Resume Next
Folder:
' Prompt the user for the folder to list.
x = InputBox(Prompt:="What folder do you want to list?" & vbCr & vbCr _
& "For example: C:\My Documents", _
Default:=Options.DefaultFilePath(wdDocumentsPath))
If x = "" Or x = " " Then
If MsgBox("Either you did not type a folder name correctly" _
& vbCr & "or you clicked Cancel. Do you want to quit?" _
& vbCr & vbCr & _
"If you want to type a folder name, click No." & vbCr & _
"If you want to quit, click Yes.", vbYesNo) = vbYes Then
Exit Sub
Else
GoTo Folder
End If
End If
' Test if folder exists.
If Dir(x, vbDirectory) = "" Then
MsgBox "The folder does not exist. Please try again."
GoTo Folder
End If
' Search the specified folder for files
' and type the listing in the document.
With Application.FileSearch
.NewSearch
.FileType = msoFileTypeOfficeFiles
' Change the .FileType to the type of files you are looking for;
' for example, the following line finds all files:
' .FileType = msoFileTypeAllFiles
.LookIn = x
.Execute
TotalFiles = .FoundFiles.Count
If TotalFiles = 0 Then
MsgBox ("There are no files in the folder!" & _
"Please type another folder to list.")
GoTo Folder
End If
' Stop the screen flickering
Application.ScreenUpdating = False
Dim tcount As Integer
tcount = ActiveDocument.Tables.Count
For j = 0 To tcount
Dim r As Word.Range
Dim aCell As Word.Cell
For Each aCell In ActiveDocument.Tables(j).Range.Cells
Set r = aCell.Range
With r.Find
.ClearFormatting
.Text = "("
.Execute
r.Collapse Direction:=wdCollapseStart
r.MoveEndUntil Cset:=vbCrLf, Count:=wdForward
r.Delete
End With
Set r = Nothing
Next aCell
Next j
ActiveDocument.Close SaveChanges:=wdDoSaveChanges
Application.ScreenUpdating = True
End With
If MsgBox("Do you want to list another folder?", vbYesNo) = vbYes Then
GoTo Folder
End If
End Sub

[thedark123]

fumei do you have msn?

[thedark123]

i need to remove everything from the '(' to ')' everything inside will be removed, including the brackets ( )...

see the code i just pasted, it does not seems to be working, the things inside the document remain unchange.

[thedark123]

this code have been modified to work, now the thing is that how will it stop deleting when its reaches the other end of the brackets " ) ", only things inside will be deleted and the text after the closing bracket should just remain, and also how to I set to delete all these brackets only when text before the ( ) are underlined?

for example: (there is the underlined blahblahblah so can remove (test1234) and text after the closing bracket should not be deleted )

blahblahblah (test1234) do not delete the text after here

for example (there is no underlined text do not remove anything)

blahblahblah (test1234) do not delete the text after here

So what i mean is that only if before the () have underlined text if dun have do not delete at all. and even if delete text after the closing brackets should just remain there and should not be deleted

[fumei]

Sorry, but your posts are really starting to annoy me. I freely admit that is a bad thing on my part.

You do NOT state things clearly, and you do NOT answer questions.

So....I will look at this post this last time. And - again - trying to understand exactly what you want.
possisble to remove all things contain in the () or anything that come after the underline Let me repeat that...anything after the underline. And that is what I gave you. Based on the sample image you supplied.

And NOW you want it so the bracketed text is removed ONLY if there is underline text prior to it.

Tell you what. Figure out what you really want, and maybe somebody can help you. Until then, if you looked up one of the instruction methods I gave - MoveEndUntil - you may learned something. Have you seen this method before? If not, were you curious perhaps? MoveEndUntil has a parameter - cset. as you can see in the use I gave you, it is using vbCrLf. As I posted, this means the Range End is moved forward until it finds a vbCrLf, or paragraph mark. In this case, that means the end of the cell.

So, you say? Well, gosh...change that to ")":

r.MoveEndUntil Cset:=")", Count:=wdForward

Hey presto! Guess what????? The range is now everything within the brackets, including the brackets. After the delete, any text that was after the brackets is still there.

So that will solve just deleting the bracketed text. As for your new logic to only do anything if underlined text is found...sorry, I am just not going to help here any more.

In the sample you supplied, ALL the previous text before the () was underlined. You made no mention of logic requiring an underline check.

This is what I mean. Your posts are not clear. And you are still posting extraneous stuff. Break things into chunks, and deal with them.

good luck.

fumei do you have msn?
MSN? Hahahahaha. Not a chance. Would never touch it.

And I DO apologize for being kind of snappy here. I am being impatient I know.

[thedark123]

Fumei my things is working prefectly thanks, just that there is still 1 small problem.

The ')' still stays there?

System displays Manage Checklist)

Because I set r.MoveEndUntil Cset:=")", Count:=wdForward

How do I fix this last problem and the script will be perfect :clap:

[fumei]

For heaven's sake...think man. What is it doing???? It is leaving the last character...hmmm? Yes? What do YOU think may be a possible solution???? Hmmmmm?

You could try moving the end...oh, I don't know...just a wee bit more....say one more character? Hmmmm?

r.MoveEndUntil Cset:=")", Count:=wdForward
r.MoveEnd Unit:=wdCharacter, Count:=1
r.Delete

It moves the End until it finds.....cset:=")"....then it moves....oh..just a little bit more...say one more character?

So. Let's review. You have something that is ALMOST working. It is just one character short. Straining the thought process would come up with the question:

"How do I move the end of the Range one more character, to include that next character, that ")"?"

Me? I would go to Help and type in:

"move the end of the Range"

And you know what? Help would be rather helpful.
How do I fix this last problem and the script will be perfect Did you try to figure out how to fix this? Did you think about it? Did you look in Help for a possible answer to what is - really - a pretty obvious question.

"How do I move the end of the Range one more character, to include that next character, that ")"?"

I am almost sorry I am posting how to "fix this". I am sorry for being rude. You are doing some reasonably detailed stuff here. Good for you. However, if you really want to be able to use this stuff, clear concise thinking is very very helpful.

[thedark123]

Solved thanks

[fumei]

well....hoorah.