Sri,
Place Below Codes in NewMacros Module at the bottom...
and Assign Shortcut Key to Macro "SelectKeywordOneInstrance" ( I assigned Crtl+-)
Code:
Sub SelectNextInstanceofSameKeyword()
Dim strString As String
strString = Trim(Selection.Text)
Application.ScreenUpdating = False
Call FillListBox(strString)
Call SelectKeywordOneInstrance(strString)
Application.ScreenUpdating = True
End Sub
Code:
Sub SelectKeywordOneInstrance(strKey As String)
Dim objExcel As Object
Dim wbkExcel As Object
Dim wksAct As Object
Dim rngWhole As Object
Dim rngCell As Object
Dim strSearch As String
Dim rngRange As Range
Dim lngRowN As Long
Dim lngcolN As Long
Dim rngVar As Range
Dim lngCheck As Long
Dim tblTable As Table
Dim lngTblID As Long
Dim lngRow_1 As Long
Dim lngcol_1 As Long
Dim lngTableCre_1 As Double
Dim lngTableFlag_1 As Long
Set rngRange = ActiveDocument.Range
For Each tblTable In ActiveDocument.Tables
lngTblID = lngTblID + 1
tblTable.ID = lngTblID
Next
If strKey = "" Then
MsgBox "No Keyword Selected.", vbInformation, "Exit:"
Exit Sub
End If
Do
Selection.Find.ClearFormatting
Selection.Find.Text = strKey
strSearch = strKey
lngcol_1 = Selection.Tables.Parent.Cells(1).ColumnIndex
lngRow_1 = Selection.Tables.Parent.Cells(1).RowIndex
lngTableCre_1 = Selection.Tables(1).ID
Selection.Find.Execute
If Selection.Information(wdWithInTable) = True Then
If Selection.Tables(1).ID <> lngTableCre_1 Or (Selection.Tables.Parent.Cells(1).ColumnIndex <> lngcol_1 Or Selection.Tables.Parent.Cells(1).RowIndex <> lngRow_1) Then
Exit Sub
End If
End If
Loop While Selection.Find.Found
End Sub
And For List box to move: I Suggest to Place ListBox12 into Header Section.
Thanks
Rahul Kumar Singh
Bookmarks