Excel moving shape with VBA
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.
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