I have a couple of hundred string values in column A. I am trying to create the same number of rectangle shapes in column B, each one taking its name from the corresponding cell in column A. I keep hitting the dreaded 400 error code
Grateful for any help.
Code:
Sub NamesSites()
Dim shpTemp As Shape
Dim rngData As Range
Dim rngOutput As Range
Dim lngIndex As Long
Set rngData = Range("a2", Cells(Rows.Count, 2).End(xlUp))
Set rngOutput = rngData.Offset(0, 1)
For lngIndex = 1 To rngData.Rows.Count
With rngOutput.Cells(lngIndex)
Set shpTemp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
.Left + ((.Width - .Height) / 2) + 2, _
.Top + 1, _
.Height - 2, _
.Height - 2)
End With
With shpTemp
.Name = rngData.Cells(lngIndex).Offset(0, -1)
ActiveSheet.DrawingObjects(shpTemp.Name).Formula = "=" & rngData.Cells(lngIndex).Address
With .TextFrame
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlVAlignCenter
.Characters.Font.Size = 8
.Characters.Font.Color = vbWhite
End With
End With
Next
End Sub