You are here:

# Excel/Code

Question
QUESTION: Tom, I appreciate the previous help you've been with my project.  I've run across another snag that I can't seem to find a simple solution to.

Part of the application produces an input box where the user will input a cell location, i.e. "a1".  This information will be saved as the coordinate location in Sheet2 "f2" for an associated image that is pasted at that location, so that other macros can move it around the screen through the use of movement buttons.  What I need is for Sheet 2 "f3:f7" to automatically determine the other cells that are being covered by the image so that another image can't be placed on top of the existing one.

So far I have:

Option Compare Text

Sub ImageLocation()
Dim S1, S2 as Worksheet
Dim Col as String
Dim RRow as Long
Set S1 = Sheets("sheet1")
set S2 = Sheets("sheet2")
If S2.Range("f2") like "a*" then
Col = "b"
ElseIf S2.Range("f2") like "a*"then
Col = "c"
End If
If S2.Range("f2") like "*1" then
RRow = 2
ElseIf S2.Range("f2") like "*2" then
RRow = 3
End If
S2.range("f3") = Col & RRow
End Sub

Given that some of the photos will occupy up to 6 cells and that the orientation can possibly change, using this code I'd essentially have to develop this code with a very large if statement for each possible size and orientation of image. That would be a rather large pain, though not impossible.  I'm looking for a more elegant solution that would automatically read the letters (could possibly be "aa" as well) to determine the column so I could make the appropriate modifications to then input the correct location reference in the following cell.

Any and all help is much appreciated.

Not really following.  But you can get the topleftcell and bottomright cell from the picture.

So I show how you can loop through all pictures on the sheet and see what area they cover.

Dim pic as Picture
Dim tl as Range, br as Range
Dim rangecovered as Range
for each pic in Activesheet.pictures
set tl = pic.TopleftCell
set br = pic.BottomRightCell
set rangecovered = Range(tl,br)
Next

you can use this to check if the space if available.

--
Regards,
Tom Ogilvy

---------- FOLLOW-UP ----------

QUESTION: Tom, Thanks, I'm having a related issue.  I've successfully turned this into a sub to check location against all other appropriate pictures I need to.  I've been trying to turn it into a function so that I can call it from multiple subs to check against those images.  I'm thinking it needs to be Boolean but am unsure how to define the parameters or call it from the other sub.

I want the parameter to simply be the name of the image we want to check against the rest of the pictures. So I was thinking

Function CheckLocation(Image as Picture) as Boolean

This seemed to work, but when I tried to call it from the other sub with

If CheckLocation = False then goto invalid

I got a Expected Array error.

From what I understand I need to Dim CheckLocation as Boolean in the sub I want to run it in, but to no avail.  Here is the code for the CheckLocation Sub

Sub CheckLocation()
On Error GoTo ec
Dim Game As Worksheet
Dim TL, BR, RCell, CCell As Range
Dim Pic As Picture
Dim Col As Long
Dim ACol, BCol, TLC, BRC, TLC2, BRC2 As String
Set Game = Sheets("Game")
Set Image = Game.Shapes(Game.Range("a13"))
If Image.Name Like "*Token*" Then
Set TL = Image.TopLeftCell
Set BR = Image.BottomRightCell
Col = TL.Column
If Col < 27 Then
ACol = Chr(64 + Col)
ElseIf Col > 26 Then
ACol = Chr(Int((Col / 26) + 64)) & Chr(((Col) Mod 26) + 64)
End If
Col = BR.Column
If Col < 27 Then
BCol = Chr(64 + Col)
ElseIf Col > 26 Then
BCol = Chr(Int((Col / 26) + 64)) & Chr(((Col) Mod 26) + 64)
End If
TLC = ACol & TL.Row
BRC = BCol & BR.Row
For Each Pic In Game.Pictures
If Pic.Name Like "*Token*" Then
If Pic.Name <> Image.Name Then
Set TL = Pic.TopLeftCell
Set BR = Pic.TopLeftCell
Col = TL.Column
If Col < 27 Then
ACol = Chr(64 + Col)
ElseIf Col > 26 Then
ACol = Chr(Int((Col / 26) + 64)) & Chr(((Col) Mod 26) + 64)
End If
Col = BR.Column
If Col < 27 Then
BCol = Chr(64 + Col)
ElseIf Col > 26 Then
BCol = Chr(Int((Col / 26) + 64)) & Chr(((Col) Mod 26) + 64)
End If
TLC2 = ACol & TL.Row
BRC2 = BCol & TL.Row
For Each RCell In Game.Range(TLC & ":" & BRC)
For Each CCell In Game.Range(TLC2 & ":" & BRC2)
Next CCell
Next RCell
End If
End If
Next Pic
End If
Exit Sub
Invalid:
Exit Sub
ec:
MsgBox Err.Description
End Sub

As always, any and all help is appreciated.

Charles

Charles,

Dim TL, BR, RCell, CCell As Range

dimensions

TL as Variant
BR as Variant
RCell as Variant
CCell as Range

If you wanted them to all be Ranges then

Dim TL as Range, BR as Range, RCell as Range, CCell as Range

however, I would use Intersect to see if ranges overlapped

Sub CheckLocation()
On Error GoTo ec
Dim Game As Worksheet
Dim TL As Range, BR As Range
Dim PicRange As Range, ImageRange As Range
Dim Pic As Picture
Dim Image As Shape
Set Game = Sheets("Game")
Set Image = Game.Shapes(Game.Range("a13"))
If Image.Name Like "*Token*" Then
Set TL = Image.TopLeftCell
Set BR = Image.BottomRightCell
Set ImageRange = Game.Range(TL, BR)
For Each Pic In Game.Pictures
If Pic.Name Like "*Token*" Then
If Pic.Name <> Image.Name Then
Set PicRange = Game.Range(Pic.TopLeftCell, Pic.BottomRightCell)
If Not Intersect(PicRange, ImageRange) Is Nothing Then GoTo Invalid
End If
End If
Next Pic
End If
Exit Sub
Invalid:
Exit Sub
ec:
MsgBox Err.Description
End Sub

If you want to checklocation to be a function that you call as you show in your description then:

' this is your routine from above renamed and modified to call the CheckLocation Function
' Note that CheckLocation is treated like a build in function.  It needs no declaration
' or dimensioning in the calling routine.

Sub NewCheckLocation()
'On Error GoTo ec
Dim Game As Worksheet
Dim TL As Range, BR As Range
Dim PicRange As Range, ImageRange As Range
Dim Pic As Picture
Dim image As Shape
Set Game = Sheets("Game")
Set image = Game.Shapes(Game.Range("a13"))
If image.Name Like "*Token*" Then
If CheckLocation(image) = False Then GoTo Invalid
End If
Exit Sub
Invalid:
Exit Sub
ec:
MsgBox Err.Description
End Sub

' Now the CheckLocation Function

Public Function CheckLocation(image As Shape) As Boolean

Dim Game As Worksheet
Dim TL As Range, BR As Range
Dim PicRange As Range, ImageRange As Range
Dim Pic As Picture

'Assume image.Name Like "*Token*" is checked in calling routine so Then
CheckLocation = True  ' set default value
Set TL = image.TopLeftCell
Set BR = image.BottomRightCell
Set Game = TL.Parent.Parent
Set ImageRange = Game.Range(TL, BR)
For Each Pic In Game.Pictures
If Pic.Name Like "*Token*" Then
If Pic.Name <> image.Name Then
Set PicRange = Game.Range(Pic.TopLeftCell, Pic.BottomRightCell)
If Not Intersect(PicRange, ImageRange) Is Nothing Then
CheckLocation = False  ' overlapping locations
Exit Function
End If
End If
End If
Next Pic
End Function

Note that my approach detects any overlap of cells.  If they have to be perfectly aligned, that could be done with

CheckLocation = False
Exit Function
End if

--
Regards,
Tom Ogilvy

This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

#### Tom Ogilvy

##### Expertise

Selected as an Excel MVP by Microsoft since 1999. Answering Excel questions in Allexperts since its inception in 2001. Able to answer questions on almost all aspects of Excel's internal capabilities. If seeking a VBA solution, please specify that in your question itself so I give you the answer you want. [Excel has weak protection - if you are distributing an application, I don't answer questions on how to protect your project from your users.]

##### Experience

Extensive experience.

Education/Credentials
Master of Science (MS) degree Operations Research (ORSA)

Awards and Honors
Microsoft MVP in Excel.