Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 07-23-2024, 05:31 AM
Shelley Lou Shelley Lou is offline VBA Add text to beginning of each row in second column Windows 10 VBA Add text to beginning of each row in second column Office 2016
Expert
VBA Add text to beginning of each row in second column
 
Join Date: Dec 2020
Posts: 259
Shelley Lou is on a distinguished road
Default VBA Add text to beginning of each row in second column

I am trying to update the code below to insert the word 'means' at the beginning of each row in the second column if the word 'means' is not already present within column 2.



After the call in Test_ApplyDefinitionsStylesToTable has been called and run, I then want to remove the word 'means'.

The reason behind this is that if text is not before an opening bracket that is not part of a sublevel, the Test_ApplyDefinitionsStylesToTable code removes the first word and bracket and inserts a numbering style, so my thinking is to prevent this from happening it would be best to insert a word first, run the code, then remove the word at the end of the code.

Does anyone have any suggestions on how to do this?

test doc for definitions table.docx

Code:
Sub Test_TextToTables()
Dim rRng As Range, rCell As Range 'Convert text to table
Dim oBorder As Border
Dim oTbl As Table
Dim i As Integer
Application.ScreenUpdating = False
Set rRng = ActiveDocument.Range
Set oTbl = rRng.ConvertToTable(Separator:=wdSeparateByTabs, NumColumns:=2, AutoFitBehavior:=wdAutoFitFixed)
With oTbl
   .Style = "Table Grid"
   .ApplyStyleHeadingRows = True
   .ApplyStyleLastRow = False
   .ApplyStyleFirstColumn = True
   .ApplyStyleLastColumn = False
   .Columns.PreferredWidth = InchesToPoints(2.7)
   .Columns(2).PreferredWidth = InchesToPoints(3.63)
For Each oBorder In .Borders
   oBorder.LineStyle = wdLineStyleNone
Next oBorder
For i = 1 To .Rows.count 'check each row
   Set rCell = .Cell(i, 1).Range 'set a range to the cells in column 1
   rCell.Style = "DefBold" 'apply the style to the range
   Set rCell = .Cell(i, 2).Range  'set a range to the cells in column 2
   rCell.Collapse 1 'collapse the range to its start
   rCell.MoveEndWhile Chr(32) 'move the end of the range to include any following spaces
   rCell.text = "" 'and empty the range
For Each oTbl In ActiveDocument.Tables
    Set rRng = oTbl.Range
    rRng.End = rRng.End - 2
    If rRng.Characters.Last = ";" Then rRng.Characters.Last = "."
  Next oTbl
'End If
   Next i
   End With
   'Call DPU_TableLeadingSpaces
   Call DPU_ApplyDefinitionStylesToTable
Application.ScreenUpdating = True
Set rRng = Nothing
Set oTbl = Nothing
Set rCell = Nothing
Set oBorder = Nothing
End Sub

Sub Test_ApplyDefinitionStylesToTable()
'Apply housestyle definition numbering to column 2 of table
Application.ScreenUpdating = False
Dim r As Long, i As Long, rCell As Range, oTbl As Table, rRng As Range
With ActiveDocument.Tables(1)
For r = 1 To .Rows.count
With .Cell(r, 2).Range
   If .Characters.First <> "(" Then
   .Style = "Definition Level A"
   Else
   i = Asc(Split(Split(.text, "(")(1), ")")(0))
   Select Case i
   Case 97 To 104, 106 To 117, 119, 121 To 122: .Style = "Definition Level 1" 'LowercaseLetter
   Case 105, 118, 120: .Style = "Definition Level 2" 'LowercaseRoman
   Case 65 To 90: .Style = "Definition Level 3" 'UppercaseLetter
   Case 48 To 57: .Style = "Definition Level 4" 'Arabic
End Select
   .Collapse wdCollapseStart
   .MoveEndUntil " "
   .End = .End + 1
   .Delete
End If
End With
Next
End With
Application.ScreenUpdating = True
End Sub
Reply With Quote
  #2  
Old 07-26-2024, 05:58 AM
vivka vivka is offline VBA Add text to beginning of each row in second column Windows 7 64bit VBA Add text to beginning of each row in second column Office 2016
Expert
 
Join Date: Jul 2023
Posts: 302
vivka is on a distinguished road
Default

Hi! If I understand your point correctly, I think your task can be easily accomplished if you Find-Replace tabs followed by "(" with tabs followed by "means" followed by "(" BEFORE converting your txt to a tbl. After doing what you need just reverse the replacements:
Code:
Sub Enter_Wd()

Dim oRng As range
Set oRng = selection.range
    oRng.Find.ClearFormatting
    oRng.Find.Replacement.ClearFormatting
    With oRng.Find
        .text = "(^9)\("
        .Replacement.text = "\1means("
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
    End With
End Sub
Reply With Quote
  #3  
Old 07-29-2024, 02:16 AM
Shelley Lou Shelley Lou is offline VBA Add text to beginning of each row in second column Windows 10 VBA Add text to beginning of each row in second column Office 2016
Expert
VBA Add text to beginning of each row in second column
 
Join Date: Dec 2020
Posts: 259
Shelley Lou is on a distinguished road
Default VBA Add text to beginning of each row in second column

Hi Vivka, unfortunately your code puts the word 'means' in front of every paragraph containing an opening bracket. How can we change the code so it only looks for instances of a closing quote mark tab and opening bracket? e.g.

"Insured Risks"[tab](the) following risks:

to

"Insured Risks"[tab]means(the) following risks.
Reply With Quote
  #4  
Old 07-29-2024, 07:08 AM
vivka vivka is offline VBA Add text to beginning of each row in second column Windows 7 64bit VBA Add text to beginning of each row in second column Office 2016
Expert
 
Join Date: Jul 2023
Posts: 302
vivka is on a distinguished road
Default

Hi, Shelley Lou!
Please, use
Code:
        .text = "(^34^9)\("
Reply With Quote
  #5  
Old 07-30-2024, 12:07 AM
Shelley Lou Shelley Lou is offline VBA Add text to beginning of each row in second column Windows 10 VBA Add text to beginning of each row in second column Office 2016
Expert
VBA Add text to beginning of each row in second column
 
Join Date: Dec 2020
Posts: 259
Shelley Lou is on a distinguished road
Default VBA Add text to beginning of each row in second column

Hi Vivka, I've added the replacement code and have also added for the text to not be bold. How do I stop the quote mark from changing though, it should remain bold - I did add \2 to .Replacement.text = "\1\2means (" - but that only changed one definition and not the rest - any ideas?

Capture.JPG

Code:
Sub Enter_Wd()
Dim oRng As Range
Set oRng = Selection.Range
    oRng.Find.ClearFormatting
    oRng.Find.Replacement.ClearFormatting
    With oRng.Find
    .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        .text = "(^34^9)\("
        .Replacement.text = "\1means ("
        .Replacement.Font.Bold = False
        .Execute Replace:=wdReplaceAll
    End With
End Sub
Reply With Quote
  #6  
Old 07-30-2024, 02:24 AM
vivka vivka is offline VBA Add text to beginning of each row in second column Windows 7 64bit VBA Add text to beginning of each row in second column Office 2016
Expert
 
Join Date: Jul 2023
Posts: 302
vivka is on a distinguished road
Default

Hi, Shelley Lou.
The problem is with the quot sign and tab to find which are bold. The following will do the job. Of course, there are other ways of doing this but they will be more complicated:
Code:
Sub Insert_Wd()

Dim oRng As range
Set oRng = selection.range
    oRng.Find.ClearFormatting
    oRng.Find.Replacement.ClearFormatting
    With oRng.Find
        .text = "(^34^9)\("
        .Replacement.text = "\1means("
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
        .text = "means\("
        .Replacement.text = "^&"
        .Replacement.Font.Bold = False
        .Execute Replace:=wdReplaceAll
    End With
End Sub
Reply With Quote
  #7  
Old 07-30-2024, 03:27 AM
Shelley Lou Shelley Lou is offline VBA Add text to beginning of each row in second column Windows 10 VBA Add text to beginning of each row in second column Office 2016
Expert
VBA Add text to beginning of each row in second column
 
Join Date: Dec 2020
Posts: 259
Shelley Lou is on a distinguished road
Default VBA Add text to beginning of each row in second column

Fabulous, thanks Vivka
Reply With Quote
  #8  
Old 07-30-2024, 05:08 AM
vivka vivka is offline VBA Add text to beginning of each row in second column Windows 7 64bit VBA Add text to beginning of each row in second column Office 2016
Expert
 
Join Date: Jul 2023
Posts: 302
vivka is on a distinguished road
Default

My pleasure, Shelley Lou!
Reply With Quote
Reply



Similar Threads
Thread Thread Starter Forum Replies Last Post
VBA Add text to beginning of each row in second column Column issues.... Inserting text in column one moves text in column two kita299 Word 3 01-15-2023 05:06 PM
VBA Add text to beginning of each row in second column Add text at beginning of cells in Word table WJSwanepoel Word VBA 2 08-17-2022 05:11 AM
Automatically put a text string at the beginning of a paragraph jthomas666 Word 2 08-22-2019 12:27 PM
VBA Add text to beginning of each row in second column Add text to the beginning/ending of each line in word ballmoney Word 1 01-17-2010 02:19 AM
Looping macros to add text to beginning and end of a paragraph pachmarhi Word VBA 0 02-16-2009 06:57 AM

Other Forums: Access Forums

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


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