CODEWITHSUNDEEP
excelpositionrangeshapesvba
Bastian
Bastian

Reputation: 21

Excel VBA - Select furthest/outmost left cell in a non-contiguous range

I've a non-contiguous range consisting out of three areas. Starting with the first area on the right, in the middle the second area and the last area is the furthest left.

To make it clear, this is my range:

=Sheet1!$H$5:$H$6,Sheet1!$G$4:$G$7,Sheet1!$C$3:$F$8

I want to place a shape in the upper left corner in this range. Therefore I tried the below code.

Dim rngPos As Range
Set rngPos = Range("myRange")
ActiveSheet.Shapes.AddShape msoShapeRectangle, rngPos.Left, rngPos.Top, 20, 20

The problem is the shape is always placed in the first area of the complete range. I tried to “Union” the range what works fine for ranges which have the same height but not with the above range.

Set rngPos = Union(Range("myRange"), Range("myRange"))

Unfortunately it’s not an option for me to place it always in the last area because I’ve ranges which are built up from left to right instead of right to left. So below doesn't work for me.

ActiveSheet.Shapes.AddShape msoShapeRectangle, rngPos.Areas(3).Left, rngPos.Top, 20, 20

I thought there must be a way to take the most upper left cell in a non-contiguous range as a reference to position a shape I just can’t figure it out how to do this. Maybe there is even a completely different approach to solve this problem.

Upvotes: 2

Views: 1010

Answers (1)

SimpleProgrammer
SimpleProgrammer

Reputation: 321

I just saw this question while solving my own non-contiguous selection problem and thought I would post my solution (not really similar to this problem). This is just a thought, but you could isolate the upper-left cell iteratively and then just plonk your shape in that cell. You would have to preference either topmost or leftmost as you could have a range that is further left, but not as high as another range.

This example preferences topmost over leftmost:

Dim leftMost As Long
Dim topMost As Long

'Some initial value larger than you could expect the answer to ever be
leftMost = 1000
topMost = 1000

For a = 1 To Selection.Areas.Count
    With Selection.Areas(a)
        For b = 1 to .Rows.Count
            If .Rows(b).Row < topMost Then
                topMost = .Rows(b).Row
                leftMost = .Rows(b).Cells(1).Column
            End If
        Next
    End With
Next

I'm no Excel expert, though. This might be a bit of a clunky solution.

Upvotes: 1

Related Questions