Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
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
Posted to microsoft.public.excel.misc
|
|||
|
|||
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
Posted to microsoft.public.excel.misc
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
MS Visual Basic Error...from MAcro | Excel Discussion (Misc queries) | |||
Visual Basic macro run time error(13) type mismatch | Excel Discussion (Misc queries) | |||
Closing File Error | Excel Discussion (Misc queries) | |||
Macro Calling Visual Basic References | Excel Discussion (Misc queries) | |||
Visual Basic Macro | Excel Discussion (Misc queries) |