Microsoft Office Forums

Go Back   Microsoft Office Forums > >

 
 
Thread Tools Display Modes
Prev Previous Post   Next Post Next
  #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
 



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 12:29 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