Juriemagic
07-30-2015, 07:52 AM
Hi good people!,
I have put together a code but only the first half works. According to the code when A2 < 3 and B2 = 0, I want a named shape plotted, and value in B2 must be made 1. If the value in A2 > 2 and B2 = 1, I want the shape deleted, as well as the value in B2 must change back to 0. This is the part I cannot get to work.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("A2") < 3 Then
If Range("B2") = 0 Then
Range("B2").FormulaR1C1 = 1
application.ScreenUpdating = False
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 100, 150, 100, 100). _
Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.150000006
.Transparency = 0
.Solid
End With
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.Name = "Scooby"
Selection.Name = "Scooby"
Range("B3").Select
Range("E8").Select
End If
If Range("A2") > 2 And Range("B2") = 1 Then
Range("B2").FormulaR1C1 = 0
ActiveSheet.Shapes.Range(Array("Scooby")).Select
Selection.Delete
Range("E8").Select
End If
End If
End Sub
The code is:
Please assist me with this minor adjustment...I have tried all I could, just no joy. Thanx a lot people!
I have put together a code but only the first half works. According to the code when A2 < 3 and B2 = 0, I want a named shape plotted, and value in B2 must be made 1. If the value in A2 > 2 and B2 = 1, I want the shape deleted, as well as the value in B2 must change back to 0. This is the part I cannot get to work.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("A2") < 3 Then
If Range("B2") = 0 Then
Range("B2").FormulaR1C1 = 1
application.ScreenUpdating = False
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 100, 150, 100, 100). _
Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.150000006
.Transparency = 0
.Solid
End With
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.Name = "Scooby"
Selection.Name = "Scooby"
Range("B3").Select
Range("E8").Select
End If
If Range("A2") > 2 And Range("B2") = 1 Then
Range("B2").FormulaR1C1 = 0
ActiveSheet.Shapes.Range(Array("Scooby")).Select
Selection.Delete
Range("E8").Select
End If
End If
End Sub
The code is:
Please assist me with this minor adjustment...I have tried all I could, just no joy. Thanx a lot people!