Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
worksheet_change event when multiple cells changed (pasted)
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
worksheet_change event when multiple cells changed (pasted)
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/ . |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Cell shape connect - is there one?
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
worksheet_change event when multiple cells changed (pasted)
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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
worksheet_change event when multiple cells changed (pasted)
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/ . |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
worksheet_change event when multiple cells changed (pasted)
|
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
worksheet_change event when multiple cells changed (pasted)
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/ |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
worksheet_change event when multiple cells changed (pasted)
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/ |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
worksheet_change event when multiple cells changed (pasted)
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 |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
worksheet_change event when multiple cells changed (pasted)
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/ |
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
worksheet_change event when multiple cells changed (pasted)
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 |
#13
Posted to microsoft.public.excel.programming
|
|||
|
|||
worksheet_change event when multiple cells changed (pasted)
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/ |
#14
Posted to microsoft.public.excel.programming
|
|||
|
|||
Cell shape connect - is there one?
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Lock or Unlock Range of Cells on Worksheet_Change Event | Excel Worksheet Functions | |||
How do I make a "Worksheet_Change event" to show any changes to cells? | Excel Worksheet Functions | |||
Worksheet_change event | Excel Programming | |||
Worksheet_Change Event | Excel Programming | |||
Worksheet_Change Event | Excel Programming |