Automatically put AutoShape in certain spots

[Lee]

I am trying to automatically put an autoshape (circle) around certain words
when it applys. For example, I am making a worksheet for employees absences.
When they put a "1" in a cell, I want it to automatically circle the reason
they were absent. If it is a "2" then it will circle a different reason. Is
there any way I can do that? Thanks!

 

[Kevin B]

Why don't you use conditional formatting instead, it would save you a lot of
work. Select the range to apply the formatting to and click FORMAT in the
menu, select CONDITIONAL FORMATTING, change the cell is to FORMULA IS and
enter the following formula, changing the A1 to the first cell in your
selected range.:

A1=1

Click the FORMAT button and then click the PATTERNS tab and assign a color
to the cell. User condition 2 for the second value.

 

[Lee]

I tried that before, the problem is I have text going over several ungrouped
cells. I need something that will print on a black and white printer and
look somewhat like a circle. I tried to do a border using the conditional
formating but it just made a bunch of little boxes.

Any other suggestions???

 

[Gord Dibben]

Lee

You can do this with a macro and event code.

Sheet event code. Right-click on the sheet tab and "View Code". Copy/paste
into that module.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim myval As String
Dim vRngInput As Range
Set vRngInput = Intersect(Target, Range("A:A")) 'adjust to suit
n = Target.Row
If vRngInput Is Nothing Then Exit Sub
For Each rng In vRngInput
'Determine the range
Select Case rng.Value
Case Is = 1: myval = "D1"
Case Is = 2: myval = "D4"
Case Is = 3: myval = "D7"
'Select the reason cell and apply the circle
End Select
Me.Range(myval).Select
Call My_Circle
Next rng
End Sub

Macro to be stored in a general module in your workbook.

Sub My_Circle()
Dim X, y As Single, area As Range
'rotate through areas - this allows multiple circles to be drawn
For Each area In Selection.Areas
With area
' x and y are numbers that are a function of the
' area's height and width
X = .Height * 0..15
y = .Width * 0..075
ActiveSheet.Ovals.Add Top:=.Top - X, Left:=.Left - y, _
Height:=.Height + 2 * X, Width:=.Width + 2 * y
ActiveSheet.Ovals(ActiveSheet.Ovals.Count) _
.Interior.ColorIndex = xlNone
End With
Next area
End Sub


Gord Dibben MS Excel MVP