Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 12-29-2020, 03:58 PM
Cray_Z Cray_Z is offline Macro to identify text - create table w/text & page numbers Windows 7 32bit Macro to identify text - create table w/text & page numbers Office 2007
Novice
Macro to identify text - create table w/text & page numbers
 
Join Date: Sep 2014
Posts: 16
Cray_Z is on a distinguished road
Default Macro to identify text - create table w/text & page numbers

I am looking for a macro that will search the active Word document for specific text


and creating a table listing the text and page number(s) that it is found on.

Searching for .text = "\(CCI*\)"

I would like the table to look similar to this:

CCI # Page #
CCI 000808 1, 3, 8
CCI 000805 3

I modified an acronym finding macro and have limited success. It currently identifies the text that I search for but only returns the data for the first occurrence in the document.

I also would like to create the table at the end of the document starting on a new page.

Any assistance will be greatly appreciated.
Reply With Quote
  #2  
Old 12-30-2020, 05:29 PM
Cray_Z Cray_Z is offline Macro to identify text - create table w/text & page numbers Windows 10 Macro to identify text - create table w/text & page numbers Office 2016
Novice
Macro to identify text - create table w/text & page numbers
 
Join Date: Sep 2014
Posts: 16
Cray_Z is on a distinguished road
Default

Update - I have successfully managed to modify an existing macro so that it identifies all occurrences of CCI numbers in a document and the create a new word document with a table of CCI numbers and page numbers.

The only thing I am unable to figure out is how to have that table be appended at the end of the source document versus having a whole new document created. Ultimately, I would like it to start a new page at the end of the source document. Any help will be greatly appreciated.
Reply With Quote
  #3  
Old 12-31-2020, 06:34 AM
eduzs eduzs is offline Macro to identify text - create table w/text & page numbers Windows 10 Macro to identify text - create table w/text & page numbers Office 2019
Competent Performer
 
Join Date: May 2017
Posts: 237
eduzs is on a distinguished road
Default

I think it is maybe necessary for you to inform the vba code you are using.
__________________
Backup your original file before doing any modification.
Reply With Quote
  #4  
Old 01-03-2021, 05:17 PM
Cray_Z Cray_Z is offline Macro to identify text - create table w/text & page numbers Windows 10 Macro to identify text - create table w/text & page numbers Office 2016
Novice
Macro to identify text - create table w/text & page numbers
 
Join Date: Sep 2014
Posts: 16
Cray_Z is on a distinguished road
Default Current code used

I would prefer to have it append the new data at the end of the source document.
Also, would like it to consolidate the CCI page numbers i.e. if CCI 1234 is found on pages 3,6, and 9 I would like the table to show CCI 1234 once with 4 page numbers versus 4 separate entries.
TIA for any assistance.


Code:
Sub Find_CCI()
'
' Find CCI Numbers Macro


    Dim oDoc_Source As Document
    Dim oDoc_Target As Document
    Dim strListSep As String
    Dim strCci As String
    Dim oTable As Table
    Dim oRange As Range
    Dim n As Long
    Dim strAllFound As String
    Dim Title As String
    Dim Msg As String

    Title = "Extract CCI List to New Document"
    
    'Show msg - stop if user does not click Yes
    Msg = "Do you want to continue?"

    If MsgBox(Msg, vbYesNo + vbQuestion, Title) <> vbYes Then
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    'Find the list separator from international settings
    'May be a comma or semicolon depending on the country
    strListSep = Application.International(wdListSeparator)
    
    'Start a string to be used for storing names of Ccis found
    strAllFound = "#"
    
    Set oDoc_Source = ActiveDocument
    
    'Create new document for CCIs
    Set oDoc_Target = Documents.Add
    
    With oDoc_Target
        'Make sure document is empty
        .Range = ""
    
        'Insert info in header - change date format as you wish
        .PageSetup.TopMargin = CentimetersToPoints(3)
        .Sections(1).Headers(wdHeaderFooterPrimary).Range.text = _
            "CCIs extracted from: " & oDoc_Source.FullName & vbCr & _
            "Created by: " & Application.UserName & vbCr & _
            "Creation date: " & Format(Date, "MMMM d, yyyy")
                
        'Adjust the Normal style and Header style
        With .Styles(wdStyleNormal)
            .Font.Name = "Arial"
            .Font.Size = 12
            .ParagraphFormat.LeftIndent = 0
            .ParagraphFormat.SpaceAfter = 6
        End With
    
        With .Styles(wdStyleHeader)
            .Font.Size = 8
            .ParagraphFormat.SpaceAfter = 0
        End With
        
        'Insert a table with room for CCI, definition, and page number
        Set oTable = .Tables.Add(Range:=.Range, NumRows:=2, NumColumns:=3)
        With oTable
            'Format the table a bit
            ' Add borders to cells
            With oTable.Rows(1).Cells.Borders
             .InsideLineStyle = wdLineStyleSingle
             .OutsideLineStyle = wdLineStyleSingle
            End With
            'Insert headings
            .Range.Style = wdStyleNormal
            .AllowAutoFit = False
            
            .Cell(1, 1).Range.text = "CCI Number"
            .Cell(1, 2).Range.text = "Definition"
            .Cell(1, 3).Range.text = "Page Number"
            'Set row as heading row
            .Rows(1).HeadingFormat = True
            .Rows(1).Range.Font.Bold = True
            .PreferredWidthType = wdPreferredWidthPercent
            .Columns(1).PreferredWidth = 20
            .Columns(2).PreferredWidth = 20
            .Columns(3).PreferredWidth = 10
            .Columns(3).Select
                Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
            
        End With
    End With
    
    With oDoc_Source
        Set oRange = .Range
        
        n = 1 'used to count below
        
        With oRange.Find
            'Use wildcard search to find CCI Numbers
            .text = "\(CCI*\)"
            .Forward = True
            .Wrap = wdFindStop
            .Format = False
            .MatchCase = False
            .MatchWildcards = True
            
            'Perform the search
            Do While .Execute
                'Continue while found
                strCci = oRange
                'Insert in target doc
                
                'If strCci is already in strAllFound, do not add again
                'If InStr(1, strAllFound, "#" & strCci & "#") = 0 Then  '''''
                    'Add new row in table from second CCI
                    If n > 1 Then oTable.Rows.Add
                    'Was not found before
                    strAllFound = strAllFound & strCci & "#"
                    
                    'Insert in column 1 in oTable
                    'Compensate for heading row
                    With oTable
                        .Cell(n + 1, 1).Range.text = strCci
                        'Insert page number in column 3
                        .Cell(n + 1, 3).Range.text = oRange.Information(wdActiveEndPageNumber)
                    End With
                    
                    n = n + 1
               ' End If   ''''
            Loop
        End With
    End With
    
    'Sort the CCIs numerically - skip if only 1 found
    If n > 2 Then
        With Selection
            .Sort ExcludeHeader:=True, FieldNumber:="Column 1", SortFieldType _
                :=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending
            
            'Go to start of document
            .HomeKey (wdStory)
        End With
    End If
        
    Application.ScreenUpdating = True
    
    'If no CCIs found, show msg and close new document without saving
    'Else keep open
    If n = 1 Then
        Msg = "No CCI references found."
        oDoc_Target.Close savechanges:=wdDoNotSaveChanges
    Else
        Msg = "Finished extracting " & n - 1 & " CCI(s) to a new document."
    End If
    
    MsgBox Msg, vbOKOnly, Title
    
    'Clean up
    Set oRange = Nothing
    Set oDoc_Source = Nothing
    Set oDoc_Target = Nothing
    Set oTable = Nothing
    
End Sub
Reply With Quote
  #5  
Old 01-03-2021, 08:54 PM
macropod's Avatar
macropod macropod is offline Macro to identify text - create table w/text &amp; page numbers Windows 10 Macro to identify text - create table w/text &amp; page numbers Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 20,726
macropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant future
Default

See, for example: https://www.msofficeforums.com/140763-post2.html
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #6  
Old 01-04-2021, 03:41 PM
Cray_Z Cray_Z is offline Macro to identify text - create table w/text &amp; page numbers Windows 10 Macro to identify text - create table w/text &amp; page numbers Office 2016
Novice
Macro to identify text - create table w/text &amp; page numbers
 
Join Date: Sep 2014
Posts: 16
Cray_Z is on a distinguished road
Default

Macropod,
I reviewed the linked code and executed it within one of the documents we are using. It identifies the CCI entries and even consolidates the duplicates. I am unable to post the results in a table at the end of the source document (on a new page). Are there any examples of how to insert the data in a formatted table (with a header and borders) at the end of the document? I have been trying to find a solution but I guess I need more help.

Thanks for your efforts to get me pointed in the right direction.
Reply With Quote
  #7  
Old 01-04-2021, 07:05 PM
macropod's Avatar
macropod macropod is offline Macro to identify text - create table w/text &amp; page numbers Windows 10 Macro to identify text - create table w/text &amp; page numbers Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 20,726
macropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant future
Default

The macro in the link inserts the output as an INDEX at the end of the document. Although Word indexes don't use a table, they normally have a tabular layout. I've revised the code in the link to ensure that outcome.

For an idea of what building a table would entail, see: https://www.msofficeforums.com/word/...html#post32031
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #8  
Old 01-05-2021, 09:32 PM
Cray_Z Cray_Z is offline Macro to identify text - create table w/text &amp; page numbers Windows 10 Macro to identify text - create table w/text &amp; page numbers Office 2016
Novice
Macro to identify text - create table w/text &amp; page numbers
 
Join Date: Sep 2014
Posts: 16
Cray_Z is on a distinguished road
Default

Thanks for all the help. I was able to modify the (inserting table) code and modify it to get exactly what I needed. Once again I thank you for all the assistance.

Please feel free to mark this as SOLVED.
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Help creating a macro to identify values that have letters and numbers. Mr J Word VBA 19 08-12-2020 03:57 PM
Text inside text boxes create headings inside my table of contents!!! How do I delete the created he carstj Word 3 04-11-2016 12:46 PM
Macro to identify text - create table w/text &amp; page numbers Macro to Add Text and Page Number to Top of Each Page Within Text eslight Word VBA 10 12-07-2012 08:18 PM
Text and page numbers in footers? MikeT1953 Word 0 07-09-2010 08:14 PM
Add text to page numbers alpruett Word 0 07-07-2010 09:40 AM

Other Forums: Access Forums - Senior Forums

All times are GMT -7. The time now is 06:49 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2021, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2021 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft