How to check if a cell contains a shape?

Question

I want to check if a particular cell has a shape, eg. B7. if it doesnt exist, make new shape at B7 (B7.top, B7.left). if it exists, move X columns to the right and make new shape

I tried checking by following code, but it doesnt work, because I dont think it can search this way:

rg = Activesheet.Range("B7")
Do While Not rg.Value = vbNullString
rg = rg.Offset(0, 6)
Loop

Answer 1

Give this a try:

Sub AddOrMoveShape()
    Dim rg As Range
    Dim shp As Shape
    Dim shapeExists As Boolean
    Dim colOffset As Integer
    
    ' Starting position
    Set rg = ActiveSheet.Range("B7")
    colOffset = 0
    
    Do
        shapeExists = False
        ' Check if a shape exists at the current cell position
        For Each shp In ActiveSheet.Shapes
            If shp.TopLeftCell.Address = rg.Offset(0, colOffset).Address Then
                shapeExists = True
                Exit For
            End If
        Next shp
        
        ' If no shape exists at the current position, create a new shape
        If Not shapeExists Then
            Set shp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
                rg.Offset(0, colOffset).Left, _
                rg.Offset(0, colOffset).Top, _
                50, 50)
            shp.Name = "MyShape" & (colOffset \ 6 + 1) ' Optional: Naming the shape
            Exit Do
        End If
       
        ' Move to the next position to the right
        colOffset = colOffset + 6
    Loop
End Sub