Is this what you mean ?
No need for all those shapes then.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(Target, Range("B8:B15")) Is Nothing Then
Application.EnableEvents = False
Target(1).Select
Application.EnableEvents = True
Application.Run "PERSONAL.XLS!OpenCalendar"
End If

End Sub

NickHK

"jfcby" wrote in message
ups.com...
Hello,

Worksheet3 rowB cells8-15, I need each cell when clicked in to call
Macro PERSONAL.XLS!OpenCalendar (popup calendar) and select the cell
so that when the date is clicked on the calendar it will be inserted in
the click cell.

To get the each cell active I've placed a rectangle to call the
PERSONAL.XLS!OpenCalendar (popup calendar). But, with the code below
when I click in cell 8-14 it always selects cell15.

How can the code be changed so that when I click in cell 8-14 it will
be selected to insert the date from the popup calendar?

Sub CellDateActivate()
With ActiveSheet.Shapes("Rectangle 4").Select
Range("B8").Select
End With
With ActiveSheet.Shapes("Rectangle 5").Select
Range("B9").Select
End With
With ActiveSheet.Shapes("Rectangle 6").Select
Range("B10").Select
End With
With ActiveSheet.Shapes("Rectangle 7").Select
Range("B11").Select
End With
With ActiveSheet.Shapes("Rectangle 8").Select
Range("B12").Select
End With
With ActiveSheet.Shapes("Rectangle 9").Select
Range("B13").Select
End With
With ActiveSheet.Shapes("Rectangle 10").Select
Range("B14").Select
End With
With ActiveSheet.Shapes("Rectangle 11").Select
Range("B15").Select
End With
Application.Run "PERSONAL.XLS!OpenCalendar"
End Sub

Thank you for your help in advance,
jfcby