Add Text to Textbox value by looping through a data range.

[Francis Brown]

Hello

I Currently have the code at the end of message.

it loops each cell in the c column in a work sheet.
takes the current textbox value and stores in a variable.
It then concatenates this to a sentance from with other variables on the
same row.
saves back to the text box and then starts again through all the iterations.
The Problem I am having is that the outputed text in the text box only has
the values from the first itteration or loop.

Could someone please explain what i'm doing wrong.

Thanks in Advance.

Code -
Dim name As String
Dim Datee As String
Dim start As String
Dim length As String
Dim newtext As String
Dim currenttext As String
ActiveWorkbook.save
finalrow = Worksheets("Adherancebycriteria").Range("c65536").End(xlUp).Row
For Each code In
Worksheets("Adherancebycriteria").Range("c8").Resize(finalrow - 7, 1)
name = code.Offset(, -2).Value
Datee = code.Offset(, 3).Value
start = code.Offset(, 4).Value
length = code.Offset(, 6).Value
currenttext = Worksheets("Time Utilisation").TextBoxes("Text Box 2").Text
newtext = currenttext & "" & name & " was in " & code.Value & " for " &
length & " at " & start & " on " & Date & "."
Worksheets("Time Utilisation").TextBoxes("Text Box 2").Text = newtext
Next code

 

[Greg Wilson]

Is this what you're looking for? I added the Chr(10) for readability of the
text box text. Minimal testing.

Regards,
Greg

Sub Test()
Dim name As String, datee As String
Dim start As String, length As String, newtext As String
Dim finalrow As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng As Range, c As Range
Dim tb As TextBox

ActiveWorkbook.Save

Set ws1 = Sheets("Adherancebycriteria")
Set ws2 = Sheets("Time Utilization")
finalrow = ws1.Range("c65536").End(xlUp).Row
Set rng = ws1.Range("C8").Resize(finalrow - 7, 1)
Set tb = ws2.TextBoxes("Text Box 2")
newtext = tb.Text

For Each c In rng.Cells
name = c.Offset(, -2).Value
datee = c.Offset(, 3).Value
start = c.Offset(, 4).Value
length = c.Offset(, 6).Value
newtext = newtext & Chr(10) & "" & name & " was in " & c.Value & _
" for " & length & " at " & start & " on " & Date & "."
Next c
tb.Text = newtext
End Sub

 

[Francis Brown]

Hello.

Thanks for answer.

I put a watch on the newtext variable and this updates correctly as the code
loops the cells. However when it comes to the last line of the code. "tb.Text
= newtext" nothing happens. The Text box remains the same value as it
started. However no errors come on screen.

Any further help much appreciated.

by the way: thanks for good examples with set variables. I will take on
board for future code.

Francis.

 

[Greg Wilson]

I used a text box from the Drawing toolbar. It updated correctly in my tests.
1. What type of text box are you using?
2. Are there more than one text box on the worksheet?
3. Is the worksheet protected?
4. Do you really need to save the wb at the start of the macro?

Your original code implied that there was already text in the text box to be
saved and the other text concatenated to it. However, if this is not the case
then the appended revised code does away with this.

The "Textbox" object is a hold over from earlier versions and is only
supported for backwards compatability. They now come under the general
definition of Shape objects. Just a guess that possibly your version no
longer supports them, in which case the appended code also classes the text
box as a Shape object and adjusts the text through Textframe.Characters.Text.
I doubt very much if this take is correct however.

Greg

Revised code:-
Sub Test()
Dim name As String, datee As String
Dim start As String, length As String, newtext As String
Dim finalrow As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng As Range, c As Range
Dim tb As Shape 'TextBox

'ActiveWorkbook.Save
Set ws1 = Sheets("Adherancebycriteria")
Set ws2 = Sheets("Time Utilization")
finalrow = ws1.Range("c65536").End(xlUp).Row
Set rng = ws1.Range("C8").Resize(finalrow - 7, 1)
Set tb = ws2.Shapes("Text Box 2")
'newtext = tb.Text
For Each c In rng.Cells
name = c.Offset(, -2).Value
datee = c.Offset(, 3).Value
start = c.Offset(, 4).Value
length = c.Offset(, 6).Value
newtext = newtext & "" & name & " was in " & c.Value & _
" for " & length & " at " & start & " on " & Date & "." & Chr(10)
Next c
'tb.Text = newtext
tb.TextFrame.Characters.Text = newtext
End Sub

 

[Francis Brown]

Discover the Problem.

It's to do with my Excel 97 version I think. Cant update a text box with
more than 255 characters even though box can have 2000. Found this link in
these forums.

http://support.microsoft.com/kb/q148815/

Here is my new code based on this.

Sub Test()
Dim name As String, datee As String
Dim start As String, length As String, newtext As String
Dim finalrow As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng As Range, c As Range
Dim tb As TextBox
Dim theRange As Range, cell As Range
Dim startPos As Integer
Dim boxlength As Single
ActiveWorkbook.save

Set ws1 = Sheets("Adherancebycriteria")
Set ws2 = Sheets("Time Utilization")
finalrow = ws1.Range("c65536").End(xlUp).Row
Set rng = ws1.Range("C8").Resize(finalrow - 7, 1)
Set tb = ws2.TextBoxes("Text Box 2")
newtext = tb.Text
startPos = 19
For Each c In rng.Cells
name = c.Offset(, -2).Value
datee = c.Offset(, 3).Value
start = c.Offset(, 4).Value
length = c.Offset(, 6).Value
boxlength = Len(name) + Len(datee) + Len(start) + Len(length) + 50
tb.Characters(start:=startPos, _
length:=boxlength).Text = Chr(10) & "" & name & " was in " &
c.Value & _
" for " & length & " at " & start & " on " & datee & "."

startPos = startPos + boxlength + 1
Next c


End Sub

As you can see I have made use of your sugestions and added some code from
the microsoft site example.

Thanks for your help. You pointed me in right direction.

I Have a question related to this but I have added to a new topic.

Francis.

 

[Greg Wilson]

Good to hear you found the solution. Take care.

Greg