This uses the sample from Post #2
Option Explicit
Sub vbax_59069()
Dim r As Range
Dim i As Long, colRank As Long
Dim oShape As Shape
Dim w, x, y, z, Data
Dim shp
With ActiveSheet
For Each shp In .Shapes
If Left(shp.Name, 5) = "TextB" Then shp.Delete
Next
Set r = .Cells(1, 1).CurrentRegion
For i = 2 To r.Rows.Count
colRank = Application.Match(.Range("B" & i), .Range("D:D"), 1)
Set oShape = Nothing
On Error Resume Next
Set oShape = .Shapes(.Range("A" & i).Value)
With oShape
w = .Top: x = .Left: y = .Height: z = .Width: Data = Range("B" & i).Value
End With
On Error GoTo 0
If oShape Is Nothing Then
MsgBox "Couldn't find " & .Range("A" & i).Value
Else
oShape.Fill.ForeColor.RGB = .Range("D" & colRank).Interior.Color
End If
Call AddText(w, x, y, z, Data)
Next i
End With
End Sub
Sub AddText(w, x, y, z, Data)
Dim Lft, Tp
Dim Tb
Lft = x + z / 2 - 20
Tp = w + y / 2 - 6
Set Tb = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, Lft, Tp, 40, 12)
With Tb
.Fill.Visible = msoFalse
.Line.Visible = msoFalse
With .TextFrame2
.TextRange.Characters.Text = Round(Data, 1)
.MarginTop = 0
End With
End With
End Sub