CODEWITHSUNDEEP
excelvba
ROCA
ROCA

Reputation: 149

Check if object is within a cell range

I am building na interactive calculation in excel. The user will move the image and press a calculate button. If the image is within a certain cell range, then range ("c2") should identify which range the object is in (There are only 4 areas, they are year quarter squares, Q1,Q2,Q3 AND Q4. Q1 is within e1:j14)enter image description here

I have already been able to move the object via VBA, but I can´t check which range it is in:

ActiveSheet.Shapes("Grupo 24").Top = ActiveSheet.Range("B5").Offset(0, 4).Top
ActiveSheet.Shapes("Grupo 24").Left = ActiveSheet.Range("B5").Offset(3, 4).Left

The VBA above will move the object to a position (image above) just right of cell ("E5"), but I cannot do a check if the image is within ("E1:J14").

When I try to check, as a test, I get the error message: Error 13 incompatible types:

If ActiveSheet.Shapes("Grupo 24").Top = ActiveSheet.Range("e1:j14") Then
 MsgBox ("Within")
 Else
 MsgBox ("Outside")

 End If

Any ideas?

Upvotes: 0

Views: 624

Answers (2)

Stavros Jon
Stavros Jon

Reputation: 1697

Below you can see an example of what you could do:

Dim horizontalAxis As Boolean
Dim verticalAxis As Boolean
Dim sht As Worksheet
Dim testRng As Range

Set sht = ThisWorkbook.Worksheets("Sheet3")
Set testRng = sht.Range("N1:S22")

horizontalAxis = sht.Shapes("Rectangle 1").Left >= testRng.Left And sht.Shapes("Rectangle 1").Left + sht.Shapes("Rectangle 1").Width <= testRng.Left + testRng.Width
Debug.Print horizontalAxis
verticalAxis = sht.Shapes("Rectangle 1").Top + sht.Shapes("Rectangle 1").Height <= testRng.Height
Debug.Print verticalAxis 
Debug.Print horizontalAxis And verticalAxis

For demonstration purposes, I am using a rectangle and a random range.

The code above checks if the shape is strictly inside the range. The smallest overlapping with a neighboring range will return false.

Upvotes: 1

Gary&#39;s Student
Gary&#39;s Student

Reputation: 96753

Let us assume that we have already assigned the Names quad1, quad2, quad3, and quad4 to the blocks of cells:

enter image description here

We determine which cell is associated with the Shape and then loop over the blocks to find which block the cell is in:

Sub quadFinder()
    Dim s As Shape, r As Range, i As Long

    Set s = ActiveSheet.Shapes("Grupo 24")
    Set r = s.TopLeftCell

    For i = 1 To 4
        If Not Intersect(r, Range("quad" & i)) Is Nothing Then
            MsgBox quad & i
            Exit Sub
        End If
    Next i

    MsgBox "not in a quad"
End Sub

Upvotes: 2

Related Questions