VBA – Add Shape to Range in Excel

Adding shapes to a range in VBA with Excel is actually a trivial task, if you are aware of the Shapes.AddShape method. It has 5 parameters, 4 of which could be pretty easily remapped to the parameters of the range:

Left – The position (in points) of the upper-left corner of the AutoShape’s bounding box relative to the upper-left corner of the document.
Top – The position (in points) of the upper-left corner of the AutoShape’s bounding box relative to the upper-left corner of the document.
Width – The width of the AutoShape’s bounding box, in points.
Height – The height of the AutoShape’s bounding box, in points.

So, once we get a range that we want to add a shape to, the following method could be used:

Sub RangeToShape(myRange As Range, Optional customstyle As Long = 11)
    
    Dim posLeft As Long
    Dim posTop As Long
    Dim posWidth As Long
    Dim posHeight As Long
    Dim myShape As Shape
    
    posLeft = myRange.Left
    posTop = myRange.Top
    posWidth = myRange.Width
    posHeight = myRange.Height
    
    With myRange.Parent
        Set myShape = .Shapes.AddShape(msoShapeRectangle, posLeft, posTop, posWidth, posHeight)
        myShape.shapeStyle = customstyle
    End With

End Sub

With the usage of it, once a range is passed, a form covering that exact range is returned. In the example below, all the cells with some values in them are covered by a consecutively colored form:

Option Explicit

Sub Main()
    
    Dim myCell As Range
    Dim customstyle As Long: customstyle = 11
    
    For Each myCell In Worksheets(1).Range("A1:Z20")
        If myCell.Value2 <> "" Then
            If customstyle > 15 Then customstyle = 11
            RangeToShape myCell, customstyle
            customstyle = customstyle + 1
        End If
    Next myCell
        
End Sub

This is the initial input:

And the result, after running the code looks like this:

Enjoy it! 🙂

VBA – Add Shape to Range in Excel

Related posts: