Iterate through rows, replace values in script with values in cells

[tomrauch]

Hi, I am trying to replace the values in my script below (see "BX", "CX" and "AX") with values contained in B1, B2,B3....C1, C2, C3....A1, A2, A3...that are found in my spreadsheet. The script should iterate through the range and replace the "X" values with the values in the cells.

Not sure how to make that cell reference in my script, though. Thanks!


Sub LoopSelection()
Worksheets("Sheet1").Select
c = ActiveWindow.RangeSelection.Address
For Each r In Worksheets("Sheet1").Range(c).Cells
ht = 20
wd = 50
tp = Range("BX")
lt = Range("CX")

ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, lt, tp, _
wd, ht).Select
Selection.Characters.Text = Range("AX")


With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 42
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 10
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Next r
End Sub

 

[John Davis]

Maybe:

Sub LoopSelection()
Dim X As Integer
Worksheets("Sheet1").Select
c = ActiveWindow.RangeSelection.Address
For X = 1 To 3
For Each r In Worksheets("Sheet1").Range(c).Cells
ht = 20
wd = 50
tp = Range("B" & X)
lt = Range("C" & X)

ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, lt, tp, _
wd, ht).Select
Selection.Characters.Text = Range("A" & X)


With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 42
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 10
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Next r
Next X
End Sub

 

[tomrauch]

Didn't seem to work -- thanks for the posting though. It put a bunch of boxes in cell A1 but nowhere else.

I think what might work is being able to reference the row with some kind of variable. I know the columns (A,B,C) but it would be nice to be able to code something like A$ where $ is the row number of the list I am iterating through?

Not sure if that is possible or not!

Thanks!!

 

[John Davis]

I tried to put your code in a loop from 1 to 3. The row is referenced by the variable X. For me I'm leaving for today/weekend. If no one else gets back to you by Monday, then I'll try to help then.

 

[tomrauch]

John, no worries - it works! Not sure what went wrong the last time I tried your modification, but I tried it again and I got the result I was looking for.

Thanks! Tom

 

[John Davis]

You're welcome Tom. Glad to hear it works for you, and thanks for the feedback.