Code to modify text when pasting

sjohnson · #1 03-17-2022, 08:47 AM

I am trying to figure out how to create two different code that modifies text that I have copied. As background, the copied text will always have this format:

"This is the text" Citation

Now sometimes there will be other quotation marks within the outer quotation marks. For instance: "This is "the" text" Citation

There will be different character spacing between the closing quotation mark and the citation. Sometimes, it will be paragraph symbols, other times braking spaces, other times only one space, etc.

For the first code, I am trying to do a few things:

Paste the copied material into Word using merge formatting.
Modify the beginning and ending quotation marks to be smart quotes.
Make sure that after the closing quotation mark, there are two spaces between that and the citation.
Get rid of any quotation marks, brackets, ellipses within the material in the parentheses.
If there were quotation marks removed, add (quotation marks removed) after the citation
If there were brackets, ellipses, etc. removed, add (alterations removed) after the citation. Thus, if there were both quotation marks and parentheses removed, add (quotation marks and alteration removed) after the citation.
Move the cursor to the end of what I just pasted (just like what the normal paste function does).

For the second code, I am trying do everything that the first code does, but just flip how it all fits together, i.e., Citation ("This is the text").

I have a starting code, but I am having a lot of difficulties figuring out how to do the more specific things in this code. For the second code, I can't even figure out how to get it to paste correctly.

Code 1:

Code:

 Sub Cite1()
Application.ScreenUpdating = False
Dim Rng As range
Set Rng = Selection.range
Rng.PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis)
With Rng
  .MoveStartUntil Chr(11), wdForward
  .End = .Start + 2
  .Text = "  "
End With
  Selection.MoveStartUntil ")", wdForward
Application.ScreenUpdating = True
End Sub

Code 2:

Code:

Sub Cite2()
Application.ScreenUpdating = False
Dim RngA As range, RngB As range, StrTmp As String
Set RngA = Selection.range
With RngA
  .Paste
  Do While .Characters.Last Like "[ " & Chr(11) & vbCr & "]"
    .End = .End - 1
  Loop
  .InsertBefore " (" & Chr(147)
  Set RngB = .Duplicate
  With RngB
    .MoveStartUntil Chr(11), wdForward
    .End = .Start + 2
    .Text = "." & Chr(148) & ") "
    .Collapse wdCollapseEnd
    .End = RngA.End
  End With
  .Collapse wdCollapseStart
  .FormattedText = RngB.FormattedText
  RngB.Text = vbNullString
End With
Application.ScreenUpdating = True
End Sub

macropod · #2 03-18-2022, 04:53 PM

Perhaps:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Word.Range, StrTxt As String, StrRef As String, StrCite As String
Set Rng = Selection.Range
With Rng
  StrTxt = Trim(.Text)
  StrRef = Trim(Split(StrTxt, """")(UBound(Split(StrTxt, """"))))
  StrCite = Trim(Left(StrTxt, Len(StrTxt) - Len(StrRef)))
  StrCite = "(" & Chr(147) & Mid(StrCite, 2, Len(StrCite) - 2) & Chr(148) & ")"
End With
Selection.Text = StrRef & "  " & StrCite
Application.ScreenUpdating = True
End Sub

sjohnson · #3 03-21-2022, 06:55 AM

Thank you so much for the starting point! So the code is failing at the "StrRef" stage and I can't figure out why.

I made a few modifications so that if I can figure out what is wrong with the "StrRef" stage it will do most of what I want it to do. I am having trouble figuring out the right way to add in an if statement to only add in (quotations marks and alterations omitted) if those characters are actually omitted. Also, did I add in the past and format function correct?

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Word.range, StrTxt As String, StrRef As String, StrCite As String
Set Rng = Selection.range
With Rng
  StrTxt = Trim(.Text)
  StrRef = Trim(Split(StrTxt, """")(UBound(Split(StrTxt, """"))))
  StrRef = Replace(StrRef, "[", "")
  StrRef = Replace(StrRef, "]", "")
  StrRef = Replace(StrRef, ". . .", "")
  StrRef = Replace(StrRef, "...", "")
  StrCite = Trim(Left(StrTxt, Len(StrTxt) - Len(StrRef)))
  StrCite = "(" & Chr(147) & Mid(StrCite, 2, Len(StrCite) - 2) & Chr(148) & ")"
End With
Selection.Text = StrRef & "  " & StrCite & "(quoations marks and alterations removed)"
PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis)
Application.ScreenUpdating = True
End Sub

macropod · #4 03-21-2022, 03:15 PM

Quote:

Originally Posted by sjohnson

Thank you so much for the starting point! So the code is failing at the "StrRef" stage and I can't figure out why.

Since you haven't told 'how' it is "failing", it's impossible to help further. The code I posted works fine with the example you gave.

It would be helpful if you attached an actual document to a post containing representative examples of what you're working with and what you want the end result to look like.

sjohnson · #5 03-22-2022, 09:28 AM

I am so sorry, it would have been easier for me to post a word document to show what I am trying to do.

macropod · #6 03-22-2022, 02:56 PM

I don't see any conversion of:
"This is the text" Citation
to:
Citation ("This is the text")
as described in your first post.

For what is shown in the attached document:

Code:

Sub Demo()
Application.ScreenUpdating = False
With Selection.Paragraphs.First.Range.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Format = False
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
    .Text = "[“”\(\[\)\]]"
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll
    .Text = Chr(34)
    .Replacement.Text = """"
    .Execute Replace:=wdReplaceAll
    .Text = ". . ."
    .Replacement.Text = "…"
    .Execute Replace:=wdReplaceAll
    .Text = "^s"
    .Replacement.Text = " "
    .Execute Replace:=wdReplaceAll
    .Text = "[ ]{2,}"
    .Replacement.Text = " "
    .Execute Replace:=wdReplaceAll
    .Text = "[^l^13]{1,}"
    .Replacement.Text = "  "
    .Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
End Sub

Note that, unlike using string manipulations, the above code retains the original formatting.

sjohnson · #7 03-23-2022, 08:25 AM

This code is amazing! I cannot thank you enough for the help! I made a few modifications so that it will paste in the information instead of just change the format of selected text. I also attached a modified example to show what I was trying to do for the second code (this is example 3). I had a few questions. First, what am I doing incorrectly in my modification to move the cursor to the end of what I just pasted in? Second, how can I add in an the quotation marks omitted and alterations removed? Third, when I modified the code to paste in items, it changes everything in the paragraph, not just the pasted in items (meaning if the previous already existed sentence has a bracket, it removes that bracket after it pastes in the new stuff). Currently, the modified code 1 is:

Code:

Sub Demo1()
Application.ScreenUpdating = False
Set Rng = Selection.range
Rng.PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis)
With Selection.Paragraphs.First.range.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Format = False
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
    .Text = "[“”\(\[\)\]]"
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll
    .Text = Chr(34)
    .Replacement.Text = """"
    .Execute Replace:=wdReplaceAll
    .Text = ". . ."
    .Replacement.Text = "…"
    .Execute Replace:=wdReplaceAll
    .Text = "^s"
    .Replacement.Text = " "
    .Execute Replace:=wdReplaceAll
    .Text = "[ ]{2,}"
    .Replacement.Text = " "
    .Execute Replace:=wdReplaceAll
    .Text = "[^l^13]{1,}"
    .Replacement.Text = "  "
    .Execute Replace:=wdReplaceAll
End With
Selection.Move wdCharacter, Len(Rng)
Application.ScreenUpdating = True
End Sub

To add in the quotation marks and alterations removed, I know I need to do some type of if statement that converts the Rng to a string and then checks the string and then does an if statement, but I can't quite figure out all of this yet (sorry, I am still learning Word VBA).

macropod · #8 03-23-2022, 02:16 PM

Quote:

Originally Posted by sjohnson

I also attached a modified example to show what I was trying to do for the second code (this is example 3)

Try the revised code below.

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range
Set Rng = Selection.Range
With Rng
  .PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis)
  With .Duplicate
    .End = .Paragraphs.First.Range.End
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Format = False
      .Forward = True
      .Wrap = wdFindStop
      .MatchWildcards = True
      .Text = "[“”\(\[\)\]]"
      .Replacement.Text = ""
      .Execute Replace:=wdReplaceAll
      .Text = Chr(34)
      .Replacement.Text = """"
      .Execute Replace:=wdReplaceAll
      .Text = ". . ."
      .Replacement.Text = "…"
      .Execute Replace:=wdReplaceAll
      .Text = "^s"
      .Replacement.Text = " "
      .Execute Replace:=wdReplaceAll
      .Text = "[ ]{2,}"
      .Replacement.Text = " "
      .Execute Replace:=wdReplaceAll
      .Text = "[^l^13]{1,}"
      .Replacement.Text = "^p"
      .Execute Replace:=wdReplaceAll
    End With
  End With
  If MsgBox("Swap Citation & Reference?", vbYesNo) = vbYes Then
    With .Find
      .Text = "(*)^13(*^13)"
      .Replacement.Text = "\2(\1)^p"
      .Wrap = wdFindStop
      .MatchWildcards = True
      .Execute Replace:=wdReplaceAll
    End With
  End If
  .Paragraphs.First.Range.Characters.Last = "  "
  .Start = .Paragraphs.First.Range.End
  .Select
End With
Application.ScreenUpdating = True
End Sub

Quote:

Originally Posted by sjohnson

First, what am I doing incorrectly in my modification to move the cursor to the end of what I just pasted in?

To move the start to the end of Rng, you need to work the Rng, not Selection. See the revised code.

Quote:

Originally Posted by sjohnson

Second, how can I add in an the quotation marks omitted and alterations removed?

I don't know what you mean by that.

Quote:

Originally Posted by sjohnson

Third, when I modified the code to paste in items, it changes everything in the paragraph, not just the pasted in items (meaning if the previous already existed sentence has a bracket, it removes that bracket after it pastes in the new stuff).

The code was written on the premise that what is being worked on is being pasted into a new paragraph. Your examples didn't indicate otherwise. I have revised the code to allow pasting into an existing paragraph.

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
How to modify the code to meet the corresponding requirements	leeqiang	Excel Programming	10	04-17-2022 03:30 AM
how modify a macro code	tarikov2006	Excel Programming	1	11-18-2016 04:10 AM
Modify right-click context menu to only allow pasting text	derajlance	Word VBA	0	05-24-2016 02:25 PM
Recovering/Removing a Password to Modify PPAM Code	Steve_B	PowerPoint	3	01-08-2014 01:06 PM
Modify vba code to print based on name in the InputBox	OTPM	Project	0	05-25-2011 02:03 AM