Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.misc
Dav
 
Posts: n/a
Default Visual Basic Autoshapes Macro


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

  #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
  #3   Report Post  
Posted to microsoft.public.excel.misc
Dav
 
Posts: n/a
Default Visual Basic Autoshapes Macro


Thanks Dave

That's Fantastic.
I use conditional formating based on the value of the current month
already, so am not able to use it for the change from last month.

The reason the symbols are used is to indicate whether the result has
improved or worsened from last month up or down & hence the arrow


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

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
MS Visual Basic Error...from MAcro G118 Excel Discussion (Misc queries) 0 December 12th 05 05:56 PM
Visual Basic macro run time error(13) type mismatch Paul Excel Discussion (Misc queries) 0 October 25th 05 07:28 AM
Closing File Error jcliquidtension Excel Discussion (Misc queries) 4 October 20th 05 12:22 PM
Macro Calling Visual Basic References phauenstein Excel Discussion (Misc queries) 1 August 24th 05 09:28 PM
Visual Basic Macro negzel Excel Discussion (Misc queries) 1 December 28th 04 10:53 PM


All times are GMT +1. The time now is 07:11 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"