|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
Macro/VBA code to select ALL text in a textbox in microsoft excel and add a new row
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 |
#2
|
|||
|
|||
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 |
#3
|
|||
|
|||
reply
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 |
#4
|
|||
|
|||
Reply to Textbox response from Excelled Software
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 |
#5
|
|||
|
|||
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 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. 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 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 |
#6
|
|||
|
|||
Check of File
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 |
#7
|
|||
|
|||
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 |
#8
|
|||
|
|||
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 |
#9
|
|||
|
|||
Quote:
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 |
#10
|
|||
|
|||
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 Let me know if this works I will be happy to make it right. Thanks |
#11
|
|||
|
|||
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 |
#12
|
|||
|
|||
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 |