Macro/VBA code to select ALL text in a textbox in microsoft excel and add a new row

jyfuller · #1 05-18-2015, 12:41 PM

I need a code that does the following:

1. copy and paste text from a sheet in a Microsoft excel book and paste it into the text box

2. Create a new paragraph at the end of every sentence, so each sentence starts on a new row (line) underneath the previous sentence. (each sentence will now start on its own line/row in the text box)

3. Select all text in the text box on each line

4. Add bullets to each sentence line.

I recorded a macro below of the code. But I don't understand how to calculate the number of characters at the end of each sentence and then create a new line for each sentence underneath the previous sentence Please help:

Range("N6:N12").Select
Selection.Copy
ActiveSheet.Shapes.Range(Array("TextBox 1")).Select
Application.CutCopyMode = False
Selection.ShapeRange(1).TextFrame2.TextRange.Chara cters.Text = _
"I am from emmaus pa. I am from emmaus pa. I am from emmaus pa. I am from emmaus pa. I am from emmaus pa. I am from emmaus pa. I am from emmaus pa. "
Selection.ShapeRange(1).TextFrame2.TextRange.Chara cters(1, 154).ParagraphFormat _
.FirstLineIndent = -13.5
With Selection.ShapeRange(1).TextFrame2.TextRange.Chara cters(1, 21).Font
.Bold = msoFalse
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"

.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Italic = msoFalse
.Name = "+mn-lt"
.UnderlineStyle = msoNoUnderline
.Strike = msoNoStrike
End With
With Selection.ShapeRange(1).TextFrame2.TextRange.Chara cters(22, 1).Font
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Name = "+mn-lt"
End With
With Selection.ShapeRange(1).TextFrame2.TextRange.Chara cters(23, 21).Font
.Bold = msoFalse
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Italic = msoFalse
.Name = "+mn-lt"
.UnderlineStyle = msoNoUnderline
.Strike = msoNoStrike
End With
With Selection.ShapeRange(1).TextFrame2.TextRange.Chara cters(44, 1).Font
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Name = "+mn-lt"
End With
With Selection.ShapeRange(1).TextFrame2.TextRange.Chara cters(45, 21).Font
.Bold = msoFalse
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Italic = msoFalse
.Name = "+mn-lt"
.UnderlineStyle = msoNoUnderline
.Strike = msoNoStrike
End With
With Selection.ShapeRange(1).TextFrame2.TextRange.Chara cters(66, 1).Font
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Name = "+mn-lt"
End With
With Selection.ShapeRange(1).TextFrame2.TextRange.Chara cters(67, 21).Font
.Bold = msoFalse
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Italic = msoFalse
.Name = "+mn-lt"
.UnderlineStyle = msoNoUnderline
.Strike = msoNoStrike
End With
With Selection.ShapeRange(1).TextFrame2.TextRange.Chara cters(88, 1).Font
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Name = "+mn-lt"
End With
With Selection.ShapeRange(1).TextFrame2.TextRange.Chara cters(89, 21).Font
.Bold = msoFalse
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Italic = msoFalse
.Name = "+mn-lt"
.UnderlineStyle = msoNoUnderline
.Strike = msoNoStrike
End With
With Selection.ShapeRange(1).TextFrame2.TextRange.Chara cters(110, 1).Font
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Name = "+mn-lt"
End With
With Selection.ShapeRange(1).TextFrame2.TextRange.Chara cters(111, 21).Font
.Bold = msoFalse
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Italic = msoFalse
.Name = "+mn-lt"
.UnderlineStyle = msoNoUnderline
.Strike = msoNoStrike
End With
With Selection.ShapeRange(1).TextFrame2.TextRange.Chara cters(132, 1).Font
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Name = "+mn-lt"
End With
With Selection.ShapeRange(1).TextFrame2.TextRange.Chara cters(133, 21).Font
.Bold = msoFalse
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Italic = msoFalse
.Name = "+mn-lt"
.UnderlineStyle = msoNoUnderline
.Strike = msoNoStrike
End With
With Selection.ShapeRange(1).TextFrame2.TextRange.Chara cters(154, 1).Font
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Name = "+mn-lt"
End With
Range("G21").Select

excelledsoftware · #2 05-20-2015, 11:00 PM

The macro recorder can really bloat things and is best used to get unknown snippets. We can make this code A LOT shorter. I need to validate a couple of things.
1. Is the data that you are copying to the text box all in 1 column?
2. Does the data on the worksheet have any blank rows between it.
3. Will all sentences end with a period?

If you could post a sample book I could write this pretty quickly for you.

Thanks

jyfuller · #3 05-21-2015, 12:07 AM

Hello Excelled software,

Thanks so much for your response. I will post an excel file tomorrow around 12pm eastern time with an example of what I am looking for. Basically, Its a copy paste of sentences to describe capital expenditures and other real estate results for a property into a textbox.

I need the text to be formatted with bullets. I was thinking a new line with bullets would start at the end of each sentence, so that way it would be easier to code (via recognition of a period sign), but you probably know an easier way to code it.

I will write you the sample in the morning. Thanks,

Jeremiah

jyfuller · #4 05-21-2015, 11:12 AM

Hi Excelled Software,

Please see the attached excel file called "Sample File". I explained the basics of what I need the code to do. I have some background in VBA, so am looking to see what you have done and implement it (and learn the basics of textbox code; for future implementation at my place of work). Thanks so much for your help. Speak to you soon,

Jeremiah

excelledsoftware · #5 05-21-2015, 09:57 PM

Well this turned out to be more of a learning experience than I anticipated. You mentioned that you wanted to understand so I went ahead and split out this working code into sections.

First off the code

Code:

Option Explicit
Sub CovertTextToShape()

  '***SECTION A***
  'Goes through each line of data and holds it into a string.
  'This string is formatted to be placed inside of the shape.
  Dim wb As Workbook, dws As Worksheet, ows As Worksheet
  Dim CheckRow As Long, LastRow As Long, HoldString As String
  Dim Oshp As Shape, CheckCol As Integer, UseCol As Integer
  Dim CountData As Long, StartRow As Integer
  
  '***SECTION B***
  'Set the variables
  Set wb = ThisWorkbook
  Set dws = wb.Worksheets("Data to be put in textbox") 'use the worksheet name
  Set ows = wb.Worksheets("Output textbox")
  Set Oshp = ows.Shapes("TextBox 1")
  UseCol = 0
  StartRow = 0
  
  '***SECTION C***
  'Search out where to get data
  For CheckRow = 2 To 50
    CountData = WorksheetFunction.CountA(dws.Range("A" & CheckRow & ":IV" & CheckRow))
    If CountData > 0 Then
      'Find the column to use
      For CheckCol = 1 To 50
        If dws.Cells(CheckRow, CheckCol).Value <> "" Then
          StartRow = CheckRow
          UseCol = CheckCol
          Exit For
        End If
      Next CheckCol
      Exit For
    End If
  Next CheckRow
  
  '***SECTION D***
  'Show messages if there are any issues
  If StartRow = 0 Then
    MsgBox "Cannot find in data in first 10 rows to parse through. Program ending"
    End
  End If
  
  If UseCol = 0 Then
    MsgBox "Cannot find data in any column to use. Program ending."
    End
  End If
  
  '***SECTION E***
  'No issues program can continue
  LastRow = dws.Cells("50000", UseCol).End(xlUp).Row
  
  '***SECTION F***
  'This version DID NOT WORK
  'HoldString = ""
  'For CheckRow = StartRow To LastRow
  '  HoldString = HoldString & dws.Cells(CheckRow, UseCol).Value & vbLf
  'Next CheckRow
  'Oshp.TextFrame.Characters.Text = HoldString
  
  '***SECTION G***
  For CheckRow = StartRow To LastRow
    CountData = Oshp.TextFrame.Characters.Count + 1
    Oshp.TextFrame.Characters(CountData).Insert String:=(dws.Cells(CheckRow, UseCol).Value & vbLf)
    'Oshp.TextFrame.Characters.Text = Oshp.TextFrame.Characters.Text & dws.Cells(CheckRow, UseCol).Value & vbLf
  Next CheckRow
  
  'Apply any formatting to the shape here.

  
End Sub

Now the explanations.
Section A
This is where you set up all of the variables to use. I have a very distinct way of how I name my variables. some might say I use long names but the reason I do not abbreviate is so I always know when something is a variable and not a built in function.

You will also notice that there are data types like Long, Integer, String etc. I will not go over those here since that it is a pretty long explanation.

Section B
Here we SET the references. This is not the same as x = 1 or similar, this is setting a reference so that Excel knows what I want it to refer to when I type wb or ows. This is useful so you do not have to keep typing the same thing. For example

Code:

x = thisworkbook.worksheets("Data to be put in textbox").Range("A1").value
'is the same as
x = dws.Range("A1").value
'When you set the references.

We also set startrow and endrow = 0. Even though when these variables are declared in Section A they are given a value of 0 this is just good practice.

Section C
Here we use the counta function to see where the data starts. We do this because when someone copies and pastes text onto a worksheet it may not always end up in column D or wherever. After we identify where the data starts we find the column. Once the column is found we set the values of those variables and then exit the for loops.

Section D
Anytime you code a program you always need to be ready for issues. In the event someone ran this code with nothing on the paste sheet we want it to let us know rather than try to run. Thats why we set the variables usecol and startrow to 0. In the event Section C did not find data it would get here, display the message, and then end the program.

Section E
No issues time to identify where we need to stop. We use a .End built-in function to find the last row. Doing it this way allows for blank cells or carriage returns. If you wanted to eliminate that you could change the code to

Code:

LastRow = dws.cells("2", UseCol).End(xlDown).Row

Section F
Lets let this section stand for FooBARRED basically I wanted to save all of the data in 1 string and then put it into the shape. Surprise Excel wont let you do that. I had to use the macro recorder to identify how to add data to existing text in the shape, which brings us to Section G

Section G
After all that here is where the data is put into the shape. There were no periods so we add the code VBLF to make a carriage return after each string. This worked no problem for me so hopefully it works ok for you.

if for some reason you want to clear out what is in the shape before you run this code just add this snippet after you set Oshp

Code:

Oshp.TextFrame.Characters.Text = ""

Please let me know if you have any issues with the code of if you have any other questions.

Thanks

jyfuller · #6 05-22-2015, 05:48 PM

Hi excelled software,

Thank you so much for the detailed explanation of the code. I am going to test it tomorrow when I have a chance and get back to you with any questions I might have. You are amazing. Thanks so much,

J

jyfuller · #7 05-29-2015, 01:02 PM

Hi excelled software,

Sorry I got back to you a week later. Hopefully you get this. I had a chance to test the code today.

There seems to be an error on the last portion of the code:

Oshp.TextFrame.Characters(CountData).Insert String:=(dws.Cells(CheckRow, UseCol).Value & vbLf)

I am getting the error message: "Application Defined or Object Defined error"

I ran through the code and understand most of it, but am not sure why its not working? Maybe you can help... Thank you

J

jyfuller · #8 05-29-2015, 01:12 PM

Hi excelled software,

At the For statement at the end of the macro I also noticed that:

CountData =Oshp.TextFrame.Characters.Count+1

The number of characters in the cell is NOT being counted by the statement and the CountData variable is set to 1 character. I think this should be counting the number of characters in the entire length of text in the cell. I'm not sure why this is, but this is also a problem.

J

excelledsoftware · #9 05-30-2015, 10:32 AM

Quote:

Originally Posted by jyfuller

Hi excelled software,

At the For statement at the end of the macro I also noticed that:

CountData =Oshp.TextFrame.Characters.Count+1

The number of characters in the cell is NOT being counted by the statement and the CountData variable is set to 1 character. I think this should be counting the number of characters in the entire length of text in the cell. I'm not sure why this is, but this is also a problem.

J

I am looking into the first issue but this one above actually is the intended way. I am counting the characters in the shape so we can append the other values into it. The reason it shows 1 is because that is the first time it runs when there are no characters in the shape. It goes to 1 because of the + 1. The value of the cell is then put into the shape.

I am guessing the reason the object error happened was because the normal versions of office have a different syntax. I still use 2003 mostly because it is the most stable in my opinion and allows me to customize exactly how I need.

I am running office 2013 in a VM and will see if the code works there. I will get back to you as soon as I can with my findings.

Thanks

excelledsoftware · #10 05-30-2015, 11:09 PM

Ok my sincere apologies for the long time this took I had quite the issue with getting my VM up and running but its all good now. Section G had an issue. I am guessing that while I was testing the code I always had a value in the textbox this would have allowed it to work but it needs to be updating a blank textbox. Please replace section G with the new code below and it should work. I tested this 12 times.

Code:

  '***SECTION G***
  Oshp.TextFrame.Characters.Text = ""
  For CheckRow = StartRow To LastRow
    CountData = Oshp.TextFrame.Characters.Count
    If CheckRow <> LastRow Then
      Oshp.TextFrame.Characters(CountData).Insert String:=(dws.Cells(CheckRow, UseCol).Value & vbLf & " ")
    Else
      Oshp.TextFrame.Characters(CountData).Insert String:=(dws.Cells(CheckRow, UseCol).Value)
    End If
  Next CheckRow

This will also fix the issue with an extra line break at the end of your data.

Let me know if this works I will be happy to make it right.

Thanks

jyfuller · #11 06-01-2015, 11:15 AM

Hello Excelled Software,

The macro is running correctly now. I may have a few more questions as I add it to the rest of the macro I built already.

Thanks so much for your expertise and help throughout.

J

excelledsoftware · #12 06-01-2015, 08:49 PM

Sounds good. If you have any questions feel free to let me know.

Thanks

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Macro to select an { includepicture } field code and format the picture behind text and 100% scale	sanpedro	Word VBA	3	03-30-2015 10:50 PM
Microsoft Word macro to find text, select all text between brackets, and delete	helal1990	Word VBA	4	02-05-2015 03:52 PM
VBA code for Microsoft Word macro — select text and insert footnote	ndnd	Word VBA	10	01-06-2015 01:47 PM
Outlook 2007 Code For Matching Textbox to a Combobox in a Different Form	lms	Outlook	4	07-03-2013 08:34 AM
Excel 2007 - formula or macro/vba code required	wrighty50	Excel Programming	3	05-13-2012 02:24 PM