B
Bourbon
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
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