View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.misc
Dave Peterson
 
Posts: n/a
Default Visual Basic Autoshapes Macro

First, have you considered just using Format|conditional formatting to show the
differences.

Green or red would seem to be a nice indicator. And, for me, it would be much
easier to see.

But if you want, this seemed to work ok for me:

Option Explicit
Sub testme()
Dim myRng As Range
Dim myCell As Range
Dim CurWks As Worksheet
Dim LastWks As Worksheet
Dim myShape As Shape
Dim myType As Long

Set CurWks = Worksheets("thismnth")
Set LastWks = Worksheets("lstmnth")

With CurWks
Set myRng = .Range("C1:L1,C5:L5,O1:X1,O5:x5")
For Each myShape In .Shapes
If myShape.AutoShapeType = msoShapeUpArrow _
Or myShape.AutoShapeType = msoShapeDownArrow Then
If Intersect(myShape.TopLeftCell, myRng) Is Nothing Then
'do nothing
Else
myShape.Delete
End If
End If
Next myShape

For Each myCell In myRng.Cells
With myCell
myType = -999
If .Value < LastWks.Range(.Address).Value Then
myType = msoShapeDownArrow
ElseIf .Value LastWks.Range(.Address).Value Then
myType = msoShapeUpArrow
End If

If myType 0 Then
Set myShape = .Parent.Shapes.AddShape(myType, 0, 0, 0, 0)
myShape.Top = .Top
myShape.Height = .Height
myShape.Width = 24
myShape.Left = .Left + ((.Width - myShape.Width) / 2)
myShape.Fill.Visible = msoFalse
End If
End With
Next myCell
End With
End Sub


If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm



Dav wrote:

I am sure this is possible in a macro, but I'm only just learning them

In a workbook I have 2 sheets one containing last months data (lstmnth)
and one containing this months data (thismnth)

On both sheets I wish to compare the ranges C1:L1, C5:L5, O1:X1, O5:x5

All the cell values are numbers,

if the number on lstmnth is this month I wish to insert a shape
MSoDownArrow possibly in the cell in thismnth

if the number on lstmnth is <this month I wish to insert a shape
MSoUpArrow possiblyin the cell in thismnth

So for example lstmnth!C1 is compared to Thismnth!C1 etc if lstmnth!C1
is greater insert a down arrow in cell C1, this needs to repeat for
each pair of cells in each of the ranges above. So repeated for D1 on
each sheet then E1 on each sheet etc

the shapes need to be transparent and centred horizontally and
verically in each cell.

If the macro could first delete any shapes already on the sheet that
would also be great

thanks in advance for your help

--
Dav
------------------------------------------------------------------------
Dav's Profile: http://www.excelforum.com/member.php...o&userid=27107
View this thread: http://www.excelforum.com/showthread...hreadid=493445


--

Dave Peterson