VBA Coding problem -text boxes
 

I have the following code which creates a text box two spaces to th
right of columm C if there is any data in columm C.

Dim myCell As Range
Dim myRng As Range

With Worksheets("sheet1")

.TextBoxes.Delete 'delete all existing textboxes???

Set myRng = .Range("c1", .Cells(.Rows.Count, "C").End(xlUp))
For Each myCell In myRng.Cells
If IsEmpty(myCell) Then
'do nothing
Else
With myCell.Offset(0, 2)
.Parent.Shapes.AddTextbox _
Orientation:=msoTextOrientationHorizontal, _
Top:=.Top, Left:=.Left, Width:=.Width, Height:=.Height
End With
End If
Next myCell
End With
End Sub

That works fine. Now what I want do is copy and paste data from colum
A, C and D into that same text box. I have the code for that as well:

Range("A5").Select
ActiveCell.FormulaR1C1 = "11/3/2000"
ActiveSheet.Shapes("Text Box 132").Select
ActiveSheet.Shapes("Text Box 132").Select
Selection.Characters.Text = "11/3/2000 "
With Selection.Characters(Start:=1, Length:=10).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("C5").Select
ActiveCell.FormulaR1C1 = "B"
ActiveSheet.Shapes("Text Box 132").Select
ActiveSheet.Shapes("Text Box 132").Select
Selection.Characters.Text = "11/3/2000 B.$ "
With Selection.Characters(Start:=1, Length:=14).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("D5").Select
ActiveCell.FormulaR1C1 = "10"
ActiveSheet.Shapes("Text Box 132").Select
Selection.Characters.Text = "11/3/2000 B.$10 "
With Selection.Characters(Start:=1, Length:=15).Font
.Name = "Ocean Sans MT Light"
.FontStyle = "Roman"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With Selection.Characters(Start:=16, Length:=1).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.HorizontalAlignment = xlCenter
Selection.ShapeRange.ScaleHeight 1.71, msoFalse
msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 1.1, msoFalse
msoScaleFromTopLeft
Range("F6").Select
End Sub

The only problem is that this code is linked to a specific Text Bo
number (in this case it is "Text Box 132") and every time I run th
first code it erases the old Text Box and creates a new one with
different number, thus when I run the second code, it does no
recognize the new Text Box number :ActiveSheet.Shapes("Text Bo
132").Select....gives me an error message.

Thus, is there a way to either modify the first code so that it doe
not erase and recreate text boxes ( and thus change the number)ever
time I run it and only to create a text box when it finds data i
columm C AND there are no existing Text Boxes two spaces to the righ
on columm C.

Or to modify the second code to insert a "generic" Text Box number s
that the program will recognize the existing text box and proceed wit
the rest of code.

This looks like a whopper but I am sure someone knows how to d
this......
Thanks again


--
Message posted from http://www.ExcelForum.com

VBA Coding problem -text boxes
 

You could try writing an if.....then statement such as that specifies that
if text box 132 is populated, don't do anything.
"Bourbon " wrote in message
...
I have the following code which creates a text box two spaces to the
right of columm C if there is any data in columm C.

Dim myCell As Range
Dim myRng As Range

With Worksheets("sheet1")

TextBoxes.Delete 'delete all existing textboxes???

Set myRng = .Range("c1", .Cells(.Rows.Count, "C").End(xlUp))
For Each myCell In myRng.Cells
If IsEmpty(myCell) Then
'do nothing
Else
With myCell.Offset(0, 2)
Parent.Shapes.AddTextbox _
Orientation:=msoTextOrientationHorizontal, _
Top:=.Top, Left:=.Left, Width:=.Width, Height:=.Height
End With
End If
Next myCell
End With
End Sub

That works fine. Now what I want do is copy and paste data from columm
A, C and D into that same text box. I have the code for that as well:

Range("A5").Select
ActiveCell.FormulaR1C1 = "11/3/2000"
ActiveSheet.Shapes("Text Box 132").Select
ActiveSheet.Shapes("Text Box 132").Select
Selection.Characters.Text = "11/3/2000 "
With Selection.Characters(Start:=1, Length:=10).Font
Name = "Arial"
FontStyle = "Regular"
Size = 10
Strikethrough = False
Superscript = False
Subscript = False
OutlineFont = False
Shadow = False
Underline = xlUnderlineStyleNone
ColorIndex = xlAutomatic
End With
Range("C5").Select
ActiveCell.FormulaR1C1 = "B"
ActiveSheet.Shapes("Text Box 132").Select
ActiveSheet.Shapes("Text Box 132").Select
Selection.Characters.Text = "11/3/2000 B.$ "
With Selection.Characters(Start:=1, Length:=14).Font
Name = "Arial"
FontStyle = "Regular"
Size = 10
Strikethrough = False
Superscript = False
Subscript = False
OutlineFont = False
Shadow = False
Underline = xlUnderlineStyleNone
ColorIndex = xlAutomatic
End With
Range("D5").Select
ActiveCell.FormulaR1C1 = "10"
ActiveSheet.Shapes("Text Box 132").Select
Selection.Characters.Text = "11/3/2000 B.$10 "
With Selection.Characters(Start:=1, Length:=15).Font
Name = "Ocean Sans MT Light"
FontStyle = "Roman"
Size = 9
Strikethrough = False
Superscript = False
Subscript = False
OutlineFont = False
Shadow = False
Underline = xlUnderlineStyleNone
ColorIndex = xlAutomatic
End With
With Selection.Characters(Start:=16, Length:=1).Font
Name = "Arial"
FontStyle = "Regular"
Size = 10
Strikethrough = False
Superscript = False
Subscript = False
OutlineFont = False
Shadow = False
Underline = xlUnderlineStyleNone
ColorIndex = xlAutomatic
End With
Selection.HorizontalAlignment = xlCenter
Selection.ShapeRange.ScaleHeight 1.71, msoFalse,
msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 1.1, msoFalse,
msoScaleFromTopLeft
Range("F6").Select
End Sub

The only problem is that this code is linked to a specific Text Box
number (in this case it is "Text Box 132") and every time I run the
first code it erases the old Text Box and creates a new one with a
different number, thus when I run the second code, it does not
recognize the new Text Box number :ActiveSheet.Shapes("Text Box
132").Select....gives me an error message.

Thus, is there a way to either modify the first code so that it does
not erase and recreate text boxes ( and thus change the number)every
time I run it and only to create a text box when it finds data in
columm C AND there are no existing Text Boxes two spaces to the right
on columm C.

Or to modify the second code to insert a "generic" Text Box number so
that the program will recognize the existing text box and proceed with
the rest of code.

This looks like a whopper but I am sure someone knows how to do
this......
Thanks again
B


---
Message posted from http://www.ExcelForum.com/

VBA Coding problem -text boxes
 

That would be fine if I only had 1 text box or only 1 worksheet but th
problem is that I will be using the same codes for several worksheet
and I will update them regularly which means I would have to modify th
codes every time to include the new text boxes....

Any other ideas?
Regards


--
Message posted from http://www.ExcelForum.com

VBA Coding problem -text boxes
 

Maybe a code that would simple say: whenever you find a text box, cop
and past the data from columm A,C and D into it (ie, the text boxes ar
in columm E)....??

--
Message posted from http://www.ExcelForum.com