Color fill cells surrounding shapes

[julhs]

I want to color fill a range of cells dependent on position of 2 shapes.
This code works,

Public Sub Color_Shapes_Position()
Dim rng As Range
Dim rng1 As Range
Dim sTopLeft As Variant
Dim sBottomRight As Variant

      sTopLeft = ActiveSheet.Shapes("Rounded Rectangle 180").TopLeftCell.Address
      sBottomRight = ActiveSheet.Shapes("Rounded Rectangle 185").BottomRightCell.Address

  Set rng1 = Range(Range(sTopLeft), Range(sBottomRight))
     rng1.Select

 With Selection.Interior
   .Pattern = xlSolid
   .PatternColorIndex = xlAutomatic
   .ThemeColor = xlThemeColorAccent6
   .TintAndShade = 0.799981688894314
   .PatternTintAndShade = 0
 End With
End Sub

BUT I want to color a slightly large range; ie

Set rng1 = Range(Range(sTopLeft -1), Range(sBottomRight +1))

Everything I have tried just so far is ending up with a Type mismatch 13 error

 

[julhs]

 

[Anthony47]

Try replacing your Set rng1= etc etc with

Set Rng1 = Range(Range(sTopLeft).Offset(-1, -1), Range(sBottomRight).Offset(1, 1))

 

[davesexcel]

You can find the rows and columns, then subtract or add to them

Note: I see you have added another post, you can use what I have supplied to set the new ranges for your other colors.

Sub Button1_Click()
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim shp1 As Shape, shp2 As Shape
    Dim r1 As Long, c1 As Long
    Dim r2 As Long, c2 As Long
    Dim rng1 As Range
    With ws
        Set shp1 = .Shapes("Rectangle 1")
        Set shp2 = .Shapes("Rectangle 2")

        With shp1
            r1 = .TopLeftCell.Row: c1 = .TopLeftCell.Column
        End With
        With shp2
            r2 = .BottomRightCell.Row: c2 = .BottomRightCell.Column
        End With

        Set rng1 = .Range(.Cells(r1 - 1, c1 - 1), .Cells(r2 + 1, c2 + 1))


        rng1.Interior.Color = rgbAliceBlue

    End With
End Sub

 

[julhs]

Hi Antony

Thanks for that.
It does add the extra fill color, top and bottom BUT it also adds it left and right as well.

While the extra on the left & right is not ideal I can live with it if there is not a way to prevent it?

 

[Anthony47]

    Set Rng1 = Range(Range(sTopLeft).Offset(-1, -1), Range(sBottomRight).Offset(1, 1))

The -1 in Red create the extra column on the left, the 1 in Blue the one on the right; replace both by 0 to color the area you prefer. That would also prevent errors in case the first shape is in column A

 

[julhs]

Thanks Dave.
It is giving me the same result as Antony’s ( extra fill left and right)

 

[julhs]

Thanks Antony.
Thats what I was after.
Many thanks
Julhs

 

[davesexcel]

Thanks Dave.
It is giving me the same result as Antony’s ( extra fill left and right)

Did you read the post? The code adds or subtracts to the row number or column number, change the numbers being added or subtracted

 

[julhs]

Dave
I posted #7 BEFORE I tweaked yours to suit me.
Having done so it does work for me as wanted