I have a working worksheet_change procedure, but I want it to work als
when multiple cells are changed simultaneously (pasted). Unfortunatel
there is no worksheet_paste event, although it does count as a chang
if only pasting one cell.

Is there a way I can easily trigger a "worksheet_change" event t
multiple cells or even a whole column

--
Message posted from http://www.ExcelForum.com

Hi
normally the chnage event should be triggered in this
case. you may loop through the range 'target' in this case.

could you post your existing code?


-----Original Message-----
I have a working worksheet_change procedure, but I want
it to work also
when multiple cells are changed simultaneously (pasted).
Unfortunately
there is no worksheet_paste event, although it does count
as a change
if only pasting one cell.

Is there a way I can easily trigger a "worksheet_change"
event to
multiple cells or even a whole column?


---
Message posted from http://www.ExcelForum.com/

.

Hi all.

I know you can use the shapes properties to figure out what cell it covers, but does any one know if the reverse is possible.

Selecting a range and via code get a true/false for "Is there a shape intersect here?" for each cell?

I believe with normal VBA there isn't, and I'm not interested in any C++ or API calls, just what is available within VBA.


Regards
Robert McCurdy


---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.716 / Virus Database: 472 - Release Date: 06/07/2004

Frank Kabel wrote:[color=blue]
[b]Hi
normally the chnage event should be triggered in this
case. you may loop through the range 'target' in this case.

could you post your existing code?



I think the change event is only when one cell is changed. There'
even an IF statement in the original code I adapted from that exit
when target 1 :(

Here's a link to the code:
http://pwei.org/dn/vba.tx

--
Message posted from http://www.ExcelForum.com

Hi
it would be easy to change this code (to also deal with
ranges). Just post you complete code :-)

-----Original Message-----
Frank Kabel wrote:
[b]Hi
normally the chnage event should be triggered in this
case. you may loop through the range 'target' in this
case.[color=blue]

could you post your existing code?



I think the change event is only when one cell is
changed. There's
even an IF statement in the original code I adapted from
that exits
when target 1 :(

Here's a link to the code:
http://pwei.org/dn/vba.txt


---
Message posted from http://www.ExcelForum.com/

.

I did he http://pwei.org/dn/vba.tx

--
Message posted from http://www.ExcelForum.com

Robert..


I think you were posting in the wrong thread...
but never mind..

This will do.. not ultra fast but does the trick :)
returns a collection of the (Shapes and the Range it covers)
for a particular area.

Function ShapeCover(rngToSearch As Range) As Collection
Dim rngCovered As Range, sh As Shape

Set ShapeCover = New Collection
For Each sh In ActiveSheet.Shapes
Set rngCovered = Range(sh.TopLeftCell, sh.BottomRightCell)
If Not Intersect(rngToSearch, rngCovered) Is Nothing Then
ShapeCover.Add Array(sh, rngCovered), sh.Name
End If

Next

End Function

Sub foo()
Dim x As Collection
Set x = ShapeCover([B3:G100])
Stop
End Sub

--
keepITcool

| www.XLsupport.com | keepITcool chello nl | amsterdam


Robert McCurdy wrote :

Hi all.

I know you can use the shapes properties to figure out what cell it
covers, but does any one know if the reverse is possible.

Selecting a range and via code get a true/false for "Is there a shape
intersect here?" for each cell?

I believe with normal VBA there isn't, and I'm not interested in any
C++ or API calls, just what is available within VBA.


Regards
Robert McCurdy

that URL appears to not work.

--
Regards,
Tom Ogilvy

"noddy26 " wrote in message
...
I did he http://pwei.org/dn/vba.txt


---
Message posted from http://www.ExcelForum.com/

In your code, you have the following:

If Target.Cells.Count 1 Then
Exit Sub
End If

which means that if you have more than one cell changing, the rest of your
code does not execute.

--
HTH,
Dianne Butterworth

I did he http://pwei.org/dn/vba.txt


---
Message posted from http://www.ExcelForum.com/

Yes. If I take that out, I still encounter the error msg box at the en
of the code "you have not entered a valid number"

I think that IF statement is there because the worksheet_change even
only occurs when a single cell is edited and not a range. Perhaps
could loop the range somehow but I"m not sure how to do that

--
Message posted from http://www.ExcelForum.com

Your assumption is incorrect.

The change event fires whether on cell or many.

The reason the code is there is to stop processing if there are multiple
cells.

You even validate that the event fires with multiple cells in your
statement.

Since your link doesn't work for me, I can't advise on how to change the
code or why you would get the cited error.

--
Regards,
Tom Ogilvy

"noddy26 " wrote in message
...
Yes. If I take that out, I still encounter the error msg box at the end
of the code "you have not entered a valid number"

I think that IF statement is there because the worksheet_change event
only occurs when a single cell is edited and not a range. Perhaps I
could loop the range somehow but I"m not sure how to do that.


---
Message posted from http://www.ExcelForum.com/

That's good news. Here is my code again:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim TimeStr As String

On Error GoTo EndMacro
If Application.Intersect(Target, Range("A1:F600")) Is Nothing Then
Exit Sub
End If
'If Target.Cells.Count 1 Then
' Exit Sub
'End If
If Target.Value = "" Then
Exit Sub
End If

Application.EnableEvents = False
With Target
If .HasFormula = False Then
' Do I need to insert a loop here?
Select Case Len(.Value)
Case 4 ' e.g., 123a = 1:23 a
TimeStr = Left(.Value, 1) & ":" & _
Mid(.Value, 2, 2) & " " & Right(.Value, 1)
Case 5 ' e.g., 1234a = 12:34 a
TimeStr = Left(.Value, 2) & ":" & _
Mid(.Value, 3, 2) & " " & Right(.Value, 1)
Case Else
Err.Raise 0
End Select
.Value = TimeValue(TimeStr)
End If
End With
Application.EnableEvents = True
Exit Sub
EndMacro:
MsgBox "You did not enter a valid time"
Application.EnableEvents = True
End Su

--
Message posted from http://www.ExcelForum.com

If target.Value = "" then

will raise an error if Target is a reference to multiple cells.

You have to adjust all the code to work with one or more cells.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim TimeStr As String
Dim cell as Range

if Time.count = 1 then
On Error GoTo EndMacro
Else
On Error Resume Next
End if
If Application.Intersect(Target, Range("A1:F600")) Is Nothing Then
Exit Sub
End If
'If Target.Cells.Count 1 Then
' Exit Sub
'End If
For each cell in Target Then
if cell.Value < "" then


Application.EnableEvents = False
With cell
If .HasFormula = False Then

Select Case Len(.Value)
Case 4 ' e.g., 123a = 1:23 a
TimeStr = Left(.Value, 1) & ":" & _
Mid(.Value, 2, 2) & " " & Right(.Value, 1)
Case 5 ' e.g., 1234a = 12:34 a
TimeStr = Left(.Value, 2) & ":" & _
Mid(.Value, 3, 2) & " " & Right(.Value, 1)
Case Else
'Err.Raise 0
TimeStr = "00:00"
End Select
.Value = TimeValue(TimeStr)
End If
End With
Application.EnableEvents = True
End if
Next cell

Exit Sub
EndMacro:
MsgBox "You did not enter a valid time"
Application.EnableEvents = True
End Sub

--
Regards,
Tom Ogilvy

"noddy26 " wrote in message
...
That's good news. Here is my code again:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim TimeStr As String

On Error GoTo EndMacro
If Application.Intersect(Target, Range("A1:F600")) Is Nothing Then
Exit Sub
End If
'If Target.Cells.Count 1 Then
' Exit Sub
'End If
If Target.Value = "" Then
Exit Sub
End If

Application.EnableEvents = False
With Target
If .HasFormula = False Then
' Do I need to insert a loop here?
Select Case Len(.Value)
Case 4 ' e.g., 123a = 1:23 a
TimeStr = Left(.Value, 1) & ":" & _
Mid(.Value, 2, 2) & " " & Right(.Value, 1)
Case 5 ' e.g., 1234a = 12:34 a
TimeStr = Left(.Value, 2) & ":" & _
Mid(.Value, 3, 2) & " " & Right(.Value, 1)
Case Else
Err.Raise 0
End Select
Value = TimeValue(TimeStr)
End If
End With
Application.EnableEvents = True
Exit Sub
EndMacro:
MsgBox "You did not enter a valid time"
Application.EnableEvents = True
End Sub


---
Message posted from http://www.ExcelForum.com/

Sorry there, I replied directly but found out this got rejected.
So here is the original reply - better late than never :)


Thanks for your comments cool.
I posted to Newsgroups: microsoft.public.excel.programming
I deleted the original message and put in a new subject. I'm not sure what else to do if one wanted to post a question. I didn't
see any trace of the old subject in my post nor in your reply.

Ah, I see I could have just used New Message, something I've never done.
I'm just in the habit of replying by right click, and choosing Reply to Sender or Group.

As for your code, this is interesting.
It does something similar I was already doing, but as it loops through all shapes on the sheet, I was hoping to avoid a situation
where one has selected a range of several cells and there are 1,000's of shapes. This is what I currently have to add and delete
shapes.


Sub AddshapeShort()
'The long version has error handling
'and one more important line
Dim Obj As Shape, sh As Worksheet, MyShape As Shape
Dim Rng As Range, c As Range, x As Integer, w As Integer
Set Rng = Selection: Set sh = ActiveSheet
For Each c In Rng.Cells
x = Int(Rnd() * 80 + 1)
With c
w = Application.Min(.Width, .Height) * 0.8
Set MyShape = sh.Shapes.AddShape(92, .Left + _
(.Width - w) / 2, .Top + (.Height - w) / 2, w, w)
MyShape.Fill.ForeColor.SchemeColor = x
End With
Next c
End Sub

Sub DelObjInRangeOldWay()
Dim Obj As Shape, sh As Worksheet
Dim Rng As Range: Set Rng = Selection
Set sh = ActiveSheet
For Each Obj In sh.Shapes
If Not Intersect(Rng, Obj.BottomRightCell) _
Is Nothing Then Obj.Delete
Next Obj
End Sub


Since I have posted I have discovered a way to do what I originally posted, which is to loop through a selection and delete any
shape within. As it only loops the cells and not the shapes it is fairly quick.


Regards
Robert McCurdy

----- Original Message -----
From: "keepITcool"
Newsgroups: microsoft.public.excel.programming
Sent: Wednesday, July 21, 2004 5:26 AM
Subject: Cell shape connect - is there one?


Robert..


I think you were posting in the wrong thread...
but never mind..

This will do.. not ultra fast but does the trick :)
returns a collection of the (Shapes and the Range it covers)
for a particular area.

Function ShapeCover(rngToSearch As Range) As Collection
Dim rngCovered As Range, sh As Shape

Set ShapeCover = New Collection
For Each sh In ActiveSheet.Shapes
Set rngCovered = Range(sh.TopLeftCell, sh.BottomRightCell)
If Not Intersect(rngToSearch, rngCovered) Is Nothing Then
ShapeCover.Add Array(sh, rngCovered), sh.Name
End If

Next

End Function

Sub foo()
Dim x As Collection
Set x = ShapeCover([B3:G100])
Stop
End Sub

--
keepITcool

| www.XLsupport.com | keepITcool chello nl | amsterdam


Robert McCurdy wrote :

Hi all.

I know you can use the shapes properties to figure out what cell it
covers, but does any one know if the reverse is possible.

Selecting a range and via code get a true/false for "Is there a shape
intersect here?" for each cell?

I believe with normal VBA there isn't, and I'm not interested in any
C++ or API calls, just what is available within VBA.


Regards
Robert McCurdy






---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.725 / Virus Database: 480 - Release Date: 19/07/2004