Count Highlighted Text Macro

[Ethen5155]

Hi all,

i hope you can help me badly about this case as i spent a lot of time to get in in VBA but unfortunately i failed :(

as you see i have a table with 4 columns

i want to count highlighted text between brackets in first column (English) and put its count number in second column (Count E), the same for other two columns as shown in screenshot below


17932

1793317933

i attached sample file too


is it possible???


Thanks in advance


cheers

Ethen

[macropod]

Try a macro such as:

Sub Demo()
Application.ScreenUpdating = False
Dim r As Long, c As Long, w As Long, i As Long
With ActiveDocument.Tables(1)
For r = 1 To .Rows.Count
For c = 1 To 3 Step 2
With .Cell(r, c).Range
i = 0
For w = 1 To .Words.Count
If .Words(w).HighlightColorIndex <> wdNoHighlight Then i = i + 1
Next
End With
.Cell(r, c + 1).Range.Text = i
Next
Next
End With
Application.ScreenUpdating = True
End Sub
For PC macro installation & usage instructions, see: http://www.gmayor.com/installing_macro.htm
For Mac macro installation & usage instructions, see: http://word.mvps.org/Mac/InstallMacro.html

[Ethen5155]

Dear Paul,

i found this result and i think it doesn't count it right as it supposed to put just number(2) for English and (3) for German on first row

17934


Thanks

[Ethen5155]

i just need to count highlighted text between brackets like [1]-[2]-{2]-[5}...etc

cheers

Ethen

[macropod]

It seems:
If .Words(w).HighlightColorIndex <> wdNoHighlight Then i = i + 1
generates a spurious additional count. Additionally, your non-alphanumeric characters also get treated as words in their own right Try:

Sub Demo()
Application.ScreenUpdating = False
Dim r As Long, c As Long, w As Long, i As Long
With ActiveDocument.Tables(1)
For r = 1 To .Rows.Count
For c = 1 To 3 Step 2
With .Cell(r, c).Range
i = 0
For w = 1 To .Words.Count
With .Words(w)
If .HighlightColorIndex = wdYellow Then
If .Characters.First Like "[0-9A-Za-z]" Then i = i + 1
End If
End With
Next
End With
.Cell(r, c + 1).Range.Text = i
Next
Next
End With
Application.ScreenUpdating = True
End Sub

[Ethen5155]

Wow, that is so fabulous :clap::clap::clap:


Thanks a lot for your generous efforts Paul

Cheers

Ethen

[Ethen5155]

Dear Paul

sorry for bothering you, i'm just asking for one more last editing

is it possible to add one more line to compare between both count numbers and if not matching then change the cell background to any color like orange for ex.

as shown

17935

[macropod]

Try:

Sub Demo()
Application.ScreenUpdating = False
Dim r As Long, c As Long, w As Long, i As Long, j As Long
With ActiveDocument.Tables(1)
For r = 1 To .Rows.Count
For c = 1 To 3 Step 2
With .Cell(r, c).Range
i = 0
For w = 1 To .Words.Count
With .Words(w)
If .HighlightColorIndex = wdYellow Then
If .Characters.First Like "[0-9A-Za-z]" Then i = i + 1
End If
End With
Next
End With
With .Cell(r, c + 1)
.Range.Text = i
If c = 1 Then
j = i
ElseIf i = j Then
.Shading.BackgroundPatternColorIndex = wdNoHighlight
.Range.Words(1).HighlightColorIndex = wdNoHighlight
ElseIf i <> j Then
.Shading.BackgroundPatternColorIndex = wdYellow
.Range.Words(1).HighlightColorIndex = wdWhite
End If
End With
Next
Next
End With
Application.ScreenUpdating = True
End Sub

[gmaxey]

Paul,

Welcome back, but I wish you would not exercise your role of "moderator" wit such zeal. While I was busy writing a solution for this poster (a post you recently deleted) you were busy deleting it.


Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRow As Row
Dim oTbl As Table
For Each oTbl In ActiveDocument.Tables
For Each oRow In oTbl.Rows
If IsNumeric(Left(oRow.Cells(2).Range.Text, Len(oRow.Cells(2).Range.Text) - 2)) Then
If oRow.Cells(2).Range.Text <> oRow.Cells(4).Range.Text Then
oRow.Range.Cells(4).Shading.BackgroundPatternColor = wdColorOrange
Else
oRow.Range.Cells(4).Shading.BackgroundPatternColor = wdColorAutomatic
End If
End If
Next
Next
lbl_Exit:
Exit Sub
End Sub

[macropod]

Hi Greg. As you can see, the other post was essentially a duplicate of post #7 here. It's still there - just not visible to you. Even we moderators sometimes find threads/posts we're moderating being gazumped by the moderations of others...

[Ethen5155]

well both codes are awesome really, Paul & Greg your help are highly appreciated..

i wish you all the luck and success while moderating this forum

Cheers

Ethen