Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 01-15-2021, 04:09 PM
mbcohn mbcohn is offline find and replace a number that's always in a table and always adjacent to a cell with known text Windows 10 find and replace a number that's always in a table and always adjacent to a cell with known text Office 2016
Advanced Beginner
find and replace a number that's always in a table and always adjacent to a cell with known text
 
Join Date: Jan 2021
Posts: 32
mbcohn is on a distinguished road
Default find and replace a number that's always in a table and always adjacent to a cell with known text

I have a series of documents that all contain identical formatting.
Each has a table that contains a cell with the value "Revision No."
Then, in the cell just to the right of that first cell, there is another cell, containing a number. So it looks kind of like this:
Revision No. 6
Except that "Revision No." and "6" are in different cells.


So, I need to programatically (because there are many documents) update the numbers.
I don't want to do a normal find and replace because, of course, the number 6 might occur in other places throughout the document, and I don't want to replace those. I only want to replace the one that represents the revision number.

If this is too hard, then there might be other ways to identify the exact cell where the revision number occurs. It does tend to be in the same position, relative to the whole table, in every document. However, I am not 100% sure that there are no exceptions.
Reply With Quote
  #2  
Old 01-15-2021, 07:07 PM
macropod's Avatar
macropod macropod is offline find and replace a number that's always in a table and always adjacent to a cell with known text Windows 10 find and replace a number that's always in a table and always adjacent to a cell with known text Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

It's probably best to look for 'Revision No.' in tables, then update the next cell. The following code, for example, does that for all documents in a folder:
Code:
Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  With wdDoc
    With .Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "Revision No."
        .Replacement.Text = ""
        .Forward = True
        .Format = False
        .Wrap = wdFindStop
      End With
      Do While .Find.Execute
        If .Information(wdWithInTable) = True Then .Cells(1).Next.Range.Text = "6"
        .Collapse wdCollapseEnd
      Loop
    End With
    .Close SaveChanges:=True
  End With
  strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
 
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #3  
Old 01-16-2021, 12:15 AM
mbcohn mbcohn is offline find and replace a number that's always in a table and always adjacent to a cell with known text Windows 10 find and replace a number that's always in a table and always adjacent to a cell with known text Office 2016
Advanced Beginner
find and replace a number that's always in a table and always adjacent to a cell with known text
 
Join Date: Jan 2021
Posts: 32
mbcohn is on a distinguished road
Default can we add export to PDF funtionality?

Thanks, macropod, this is perfect.



I actually also need to convert each document to a PDF, saving over any PDFs that are already there with the same names.


In order to do this, I tried to just modify your code like so.

I added:

Code:
Word_ExportPDF
Just before:
Code:
    .Close SaveChanges:=True




Which would call this:
Code:
Sub Word_ExportPDF()
'PURPOSE: Generate A PDF Document From Current Word Document
'NOTES: PDF Will Be Saved To Same Folder As Word Document File
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

Dim CurrentFolder As String
Dim FileName As String
Dim myPath As String
Dim UniqueName As Boolean

UniqueName = False

'Store Information About Word File
  myPath = ActiveDocument.FullName
  CurrentFolder = ActiveDocument.Path & "\"
  FileName = Mid(myPath, InStrRev(myPath, "\") + 1, _
   InStrRev(myPath, ".") - InStrRev(myPath, "\") - 1)

'Does File Already Exist?
'If so, too bad
'  Do While UniqueName = False
 '   DirFile = CurrentFolder & FileName & ".pdf"
  '  If Len(Dir(DirFile)) <> 0 Then
   '   UserAnswer = MsgBox("File Already Exists! Click " & _
    '   "[Yes] to override. Click [No] to Rename.", vbYesNoCancel)
      
     ' If UserAnswer = vbYes Then
        UniqueName = True
 '     ElseIf UserAnswer = vbNo Then
 '       Do
 '         'Retrieve New File Name
 '           FileName = InputBox("Provide New File Name " & _
 '            "(will ask again if you provide an invalid file name)", _
 '            "Enter File Name", FileName)
          
          'Exit if User Wants To
  '          If FileName = "False" Or FileName = "" Then Exit Sub
  '      Loop While ValidFileName(FileName) = False
  '    Else
   '     Exit Sub 'Cancel
   '   End If
   ' Else
   '   UniqueName = True
   ' End If
'  Loop
  
'Save As PDF Document
  On Error GoTo ProblemSaving
    ActiveDocument.ExportAsFixedFormat _
     OutputFileName:=CurrentFolder & FileName & ".pdf", _
     ExportFormat:=wdExportFormatPDF
  On Error GoTo 0

'Confirm Save To User
  With ActiveDocument
    FolderName = Mid(.Path, InStrRev(.Path, "\") + 1, Len(.Path) - InStrRev(.Path, "\"))
  End With
  
 ' MsgBox "PDF Saved in the Folder: " & FolderName

Exit Sub

'Error Handlers
ProblemSaving:
  MsgBox "There was a problem saving your PDF. This is most commonly caused" & _
   " by the original PDF file already being open."
  Exit Sub

End Sub
However, that led to an "Invalid Procedure call or argument (Error 5)" on:

Code:
  FileName = Mid(myPath, InStrRev(myPath, "\") + 1, _
   InStrRev(myPath, ".") - InStrRev(myPath, "\") - 1)
I googled around, and the issue seems to have something to do with the limits of Mid, but I'm not sure how to correct it.

Of course, this problem has nothing to do with your code. If you want to suggest another way to add conversion to PDFs from within what you wrote, that's fine too. Many thanks.
Reply With Quote
  #4  
Old 01-16-2021, 03:35 AM
macropod's Avatar
macropod macropod is offline find and replace a number that's always in a table and always adjacent to a cell with known text Windows 10 find and replace a number that's always in a table and always adjacent to a cell with known text Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Simply change:
Code:
    .Close SaveChanges:=True
to:
Code:
    .SaveAs FileName:=Split(.FullName, ".doc")(0) & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
    .Close SaveChanges:=False
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #5  
Old 01-16-2021, 03:41 PM
mbcohn mbcohn is offline find and replace a number that's always in a table and always adjacent to a cell with known text Windows 10 find and replace a number that's always in a table and always adjacent to a cell with known text Office 2016
Advanced Beginner
find and replace a number that's always in a table and always adjacent to a cell with known text
 
Join Date: Jan 2021
Posts: 32
mbcohn is on a distinguished road
Default

Thanks. This seems to work great.


Just curious. Why are we changing SaveChanges to False? Don't we still want to save changes?


Also, what if the files were in nested folders? Is there a way to have the option to point this at a folder full of other folders?
Reply With Quote
  #6  
Old 01-16-2021, 05:39 PM
mbcohn mbcohn is offline find and replace a number that's always in a table and always adjacent to a cell with known text Windows 10 find and replace a number that's always in a table and always adjacent to a cell with known text Office 2016
Advanced Beginner
find and replace a number that's always in a table and always adjacent to a cell with known text
 
Join Date: Jan 2021
Posts: 32
mbcohn is on a distinguished road
Default

I have to take back my statement that it works great. It's only updating the PDFs.
The Word files are staying the same. That's not the intended behavior...
Reply With Quote
  #7  
Old 01-16-2021, 08:43 PM
macropod's Avatar
macropod macropod is offline find and replace a number that's always in a table and always adjacent to a cell with known text Windows 10 find and replace a number that's always in a table and always adjacent to a cell with known text Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

In that case, change:
Code:
.Close SaveChanges:=False
back to:
Code:
.Close SaveChanges:=True
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #8  
Old 01-16-2021, 11:26 PM
mbcohn mbcohn is offline find and replace a number that's always in a table and always adjacent to a cell with known text Windows 10 find and replace a number that's always in a table and always adjacent to a cell with known text Office 2016
Advanced Beginner
find and replace a number that's always in a table and always adjacent to a cell with known text
 
Join Date: Jan 2021
Posts: 32
mbcohn is on a distinguished road
Default

Thanks. This appears to work very well.
It would still be nice to apply this to nested folders, but I guess I might be able to adapt the code you wrote for me in the other thread (157036) to do that.
Reply With Quote
  #9  
Old 01-16-2021, 11:39 PM
macropod's Avatar
macropod macropod is offline find and replace a number that's always in a table and always adjacent to a cell with known text Windows 10 find and replace a number that's always in a table and always adjacent to a cell with known text Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

I didn't write the code to process nested folders because that's not what you asked for. By comparing the code in this thread with that of your other thread, it should be apparent how the code in this thread could be adapted to process nested folders.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #10  
Old 03-19-2021, 04:28 PM
mbcohn mbcohn is offline find and replace a number that's always in a table and always adjacent to a cell with known text Windows 10 find and replace a number that's always in a table and always adjacent to a cell with known text Office 2016
Advanced Beginner
find and replace a number that's always in a table and always adjacent to a cell with known text
 
Join Date: Jan 2021
Posts: 32
mbcohn is on a distinguished road
Default

I have a follow-up to this. Perhaps macropod will see it and be kind enough to comment.


I have a cell that contains the text "Published". I want to update the cell just to the right of it.


Unfortunately, there is another cell in the same table that also says "Published." In that case, it's a key, not a value, so I don't want it updated.


In other words:


first row : | published| jan 1, 2021 |
second row: | status | published |
third row: | type | ABC |


What I want to do here is to change the date.
So basically, I want to find the cell in the leftmost column with the word "Published" in it, and then I want to do an offset of (0,1) to go one cell to the right, and change the value there.


If there's another way to think about this, then I can provide more information. For example, I could name the coordinates of each cell involved. They will always be the same.
Reply With Quote
  #11  
Old 03-20-2021, 03:07 AM
macropod's Avatar
macropod macropod is offline find and replace a number that's always in a table and always adjacent to a cell with known text Windows 10 find and replace a number that's always in a table and always adjacent to a cell with known text Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

You could edit the code in post #2, changing:
Code:
        .Text = "Revision No."
to:
Code:
        .MatchWildcards = True
        .Text = "[PR][eu][bv][ils]{3}[ehno]{2}[ Ndo]{1,3}"
and changing:
Code:
        If .Information(wdWithInTable) = True Then .Cells(1).Next.Range.Text = "6"
to something like:
Code:
        If .Information(wdWithInTable) = True Then
          Select Case .Text
            Case "Revision No."
              .Cells(1).Next.Range.Text = "6"
            Case "Published "
              If .Cells(1).ColumnIndex = 1 Then
                .Cells(1).Next.Range.Text = Format(Now, "DDD, D MMM YYYY")
              End If
          End Select
        End If
Since you don't say how the new date is to be determined, I've used 'Format(Now, "DDD, D MMM YYYY")' to insert today's date.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #12  
Old 03-31-2021, 06:37 PM
mbcohn mbcohn is offline find and replace a number that's always in a table and always adjacent to a cell with known text Windows 10 find and replace a number that's always in a table and always adjacent to a cell with known text Office 2016
Advanced Beginner
find and replace a number that's always in a table and always adjacent to a cell with known text
 
Join Date: Jan 2021
Posts: 32
mbcohn is on a distinguished road
Default not updating

It's still not updating the right cell, actually.



In case it matters: These tables have two columns and four rows.

There may be some edge cases where the number of rows varies, so I would rather not key the replacement to the exact cell, but that could be worked out if necessary.


Here's what I'm using:


Code:
Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=strFolder & "" & strFile, AddToRecentFiles:=False, Visible:=False)
  With wdDoc

    
    With .Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .MatchWildcards = True
        .Text = "[PR][eu][bv][ils]{3}[ehno]{2}[ Ndo]{1,3}."
        .Replacement.Text = ""
        .Forward = True
        .Format = False
        .Wrap = wdFindStop
      End With
      Do While .Find.Execute
        If .Information(wdWithInTable) = True Then
          Select Case .Text
            Case "Revision No."
             .Cells(1).Next.Range.Text = "2.5"
            Case "Published"
              If .Cells(1).ColumnIndex = 1 Then
                .Cells(1).Next.Range.Text = "2 April 2021"
              End If
          End Select
        End If
        .Collapse wdCollapseEnd
      Loop
    End With
    
    Word_ExportPDF
    
    .SaveAs FileName:=Split(.FullName, ".doc")(0) & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
    .Close SaveChanges:=True
  
  End With
  strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
 
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

Sub Word_ExportPDF()
'PURPOSE: Generate A PDF Document From Current Word Document
'NOTES: PDF Will Be Saved To Same Folder As Word Document File
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

Dim CurrentFolder As String
Dim FileName As String
Dim myPath As String
Dim UniqueName As Boolean

UniqueName = False

'Store Information About Word File
  myPath = ActiveDocument.FullName
  CurrentFolder = ActiveDocument.Path & ""
  FileName = Mid(myPath, InStrRev(myPath, "") + 1, _
   InStrRev(myPath, ".") - InStrRev(myPath, "") - 1)

'Does File Already Exist?
'If so, too bad
'  Do While UniqueName = False
 '   DirFile = CurrentFolder & FileName & ".pdf"
  '  If Len(Dir(DirFile)) <> 0 Then
   '   UserAnswer = MsgBox("File Already Exists! Click " & _
    '   "[Yes] to override. Click [No] to Rename.", vbYesNoCancel)
      
     ' If UserAnswer = vbYes Then
        UniqueName = True
 '     ElseIf UserAnswer = vbNo Then
 '       Do
 '         'Retrieve New File Name
 '           FileName = InputBox("Provide New File Name " & _
 '            "(will ask again if you provide an invalid file name)", _
 '            "Enter File Name", FileName)
          
          'Exit if User Wants To
  '          If FileName = "False" Or FileName = "" Then Exit Sub
  '      Loop While ValidFileName(FileName) = False
  '    Else
   '     Exit Sub 'Cancel
   '   End If
   ' Else
   '   UniqueName = True
   ' End If
'  Loop
  
'Save As PDF Document
  On Error GoTo ProblemSaving
    ActiveDocument.ExportAsFixedFormat _
     OutputFileName:=CurrentFolder & FileName & ".pdf", _
     ExportFormat:=wdExportFormatPDF
  On Error GoTo 0

'Confirm Save To User
  With ActiveDocument
    FolderName = Mid(.Path, InStrRev(.Path, "") + 1, Len(.Path) - InStrRev(.Path, ""))
  End With
  
 ' MsgBox "PDF Saved in the Folder: " & FolderName

Exit Sub

'Error Handlers
ProblemSaving:
  MsgBox "There was a problem saving your PDF. This is most commonly caused" & _
   " by the original PDF file already being open."
  Exit Sub

End Sub
Reply With Quote
  #13  
Old 03-31-2021, 07:07 PM
macropod's Avatar
macropod macropod is offline find and replace a number that's always in a table and always adjacent to a cell with known text Windows 10 find and replace a number that's always in a table and always adjacent to a cell with known text Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Quote:
Originally Posted by mbcohn View Post
It's still not updating the right cell, actually.
When the Find data are as specified by you (i.e. 'Revision No.' or 'Published' in column 1), the code works for me, updating the cell in column 2.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #14  
Old 03-31-2021, 08:51 PM
mbcohn mbcohn is offline find and replace a number that's always in a table and always adjacent to a cell with known text Windows 10 find and replace a number that's always in a table and always adjacent to a cell with known text Office 2016
Advanced Beginner
find and replace a number that's always in a table and always adjacent to a cell with known text
 
Join Date: Jan 2021
Posts: 32
mbcohn is on a distinguished road
Default

For me, it updates the revision number but not the publication date.
The word "Published" does seem to have a space after it in my tables. I tried adding a space after the search term, but it didn't seem to make any difference.
Reply With Quote
  #15  
Old 03-31-2021, 09:18 PM
macropod's Avatar
macropod macropod is offline find and replace a number that's always in a table and always adjacent to a cell with known text Windows 10 find and replace a number that's always in a table and always adjacent to a cell with known text Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Change:
.Text = "[PR][eu][bv][ils]{3}[ehno]{2}[ Ndo]{1,3}."
to:
.Text = "[PR][eu][bv][ils]{3}[ehno]{2}[ Ndo]{1,3}"
and change:
Case "Published"
to:
Case "Published "
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
Reply

Tags
tables, vba, vba find and replace

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Find and Replace rows in a table based on bold text. OfficeAssociate99 Word VBA 2 07-26-2017 06:32 AM
Select Cell Text to paste into Find/Replace CBarry Word VBA 2 02-16-2017 04:37 AM
Increase number in cell, based on value in adjacent cell scottyb Excel 3 02-02-2017 03:51 AM
find and replace a number that's always in a table and always adjacent to a cell with known text VBA Table – Search All Tables - Find & Replace Text in Table Cell With Specific Background Color jc491 Word VBA 8 09-30-2015 06:10 AM
Word VBA Find Table Text Shading Colour and replace with another QA_Compliance_Advisor Word VBA 10 09-19-2014 08:36 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 01:22 AM.


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