Excel Moving Shape With VBA

Contents hide

Problem Description:

I have a small Excel VBA problem that is beyond my current abilities.

I have a range of 10 cells in column, like B1:B10 that will have a numeric value manually inserted.

I also have a range of cells between L3:Z30, and somewhere in that area there are 10 cells scattered that takes value from the B1:B10 range. (ex: U11 =B1, Q16=B2,..and so on, scattered in roughly the area defined by L3:Z30).
I’m trying to make a VBA macro that parses the first interval(B1:B10),cell by cell, searches the same value in the interval L3:Z30 and move an "Arrow" shape to that cell, then check the value in B2, searches and move the shape to the newfound cell, then B3 and so on.

check B1 value > search L3:L30 >finds U11(same value as B1) > moves "Arrow" to U11> check B2 value >search L3:L30 >finds Q16(same value as B2) > moves "Arrow" to Q16>….and so on.

I would also be interested if I can make the arrow stop and display a textbox if it finds the value in a certain cell (for example, it finds the value in B5 in P17)

I’ve been trying to define a code and to find solutions online but I could use some guidance. I’m sure it’s a pretty simple code, I just need a hint if anyone is willing to take a look at that.

Thank you.

I’ve been trying to put together a code with no effect 🙁

Solution – 1

C Hypercube, This should give you all the tools you need to adapt it to your problem.
I’ve tried to give you as many comments as possible.

With these tools alone you should be able to figure out a long list of excel VBA projects.

Next time, try to put something together, even if it’s terrible before asking the community.

Option Explicit
Sub Basic_Example()
    
    ' Defining the two ranges we're interacting with
    Dim SourceRG As Range
    Dim SearchRG As Range
    Dim FoundRG As Range
    Dim CL As Range
    
    ' Set the Object variables
    Set SourceRG = Sheet2.Range("B1:B10")
    Set SearchRG = Sheet2.Range("F3:Z30")
    
    ' Define how script should handle errors.
    ' In this case, if we encounter an error, the script will jump to
    ' the label at the end: "ERRORHAND:", Where the error will be cleared,
    ' and the script will just to "NEXTCL:" Lable, effectively skipping
    ' the not found Value.
    On Error GoTo ERRORHAND
    
    ' Iterate(Loop) through each cell in SourceRG
    ' For each range object in the collection "cells" inside the range "SourceRG"
    ' Each iteration CL is "Set" as range object SourceRG(cellnumber)
    For Each CL In SourceRG.Cells
    
        ' We can use "Debug.Print" to early test our code is working
        ' This line prints the address of each found cell
        Debug.Print SearchRG.Find(CL.Value).Address
        
        ' Now we can store that found range in another range object
        ' Remember we use "Set" when defining Object variables
        Set FoundRG = SearchRG.Find(CL.Value)
        
        ' This will move the Arrow. You Can see I've named my arrow "RedArrow" to
        ' make this part nice and easy. If you wanted to shorten this code, or
        ' frequently reference "RedArrow", we could save the object in an object
        ' variable like:
        ' Dim shpArrow as Object
        ' Set shpArrow = Sheet2.Shapes("RedArrow")
        ' ...
        ' To move/resize or otherwise translate our arrow object we can access
        ' the object's left, right, top, bottom, height, width properties.
        ' " The Left property of the RedArrow should equal the left property of the FoundRG object
        Sheet2.Shapes("RedArrow").Left = FoundRG.Offset(0, 1).Left
        Sheet2.Shapes("RedArrow").Top = FoundRG.Top - _
                                        (Sheet2.Shapes("RedArrow").Height / 2) + _
                                        (FoundRG.Height / 2)
                                        
        ' In Order to make sure Excel moves the arrow before displaying messagebox
        DoEvents
        Application.Calculate
                                        
        ' MessageBox MessageText, MessageStyle/MessageBottons, Message Title
        MsgBox "The value " & CL.Value & " was found at " & FoundRG.Address, _
                vbInformation + vbOKOnly, _
                "Found Value!!!"
        
NEXTCL:
    Next CL
    
    Exit Sub
ERRORHAND:
    Err.Clear
    Resume NEXTCL
End Sub

Rate this post