PDA

View Full Version : Replace All fires WS_Change for every cell



Paul_Hossler
04-07-2014, 12:41 PM
I have a WS_Change event to upper case entered text (does other things, but UC is easiest to demo)



Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim r As Range, c As Range

If Intersect(Target, Range("A:B")) Is Nothing Then Exit Sub

Set r = Intersect(Target, Target.Parent.UsedRange, Target.Parent.Range("A:B"))

Application.EnableEvents = False
Application.ScreenUpdating = False

For Each c In r.Cells
c.Value = UCase(c.Value)

' MsgBox "Stopped"

Next

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub




If I do a [Replace All] to update a number of cells, the [Replace All] seems to do the global replace (screen updating is off), BUT then the event seems to do one cell as a time (the MsgBox keeps popping up) and there's screen flicker and it runs slow

Is there any way get the event to not do one cell at time after a [Replace All] ?

Paul

Kenneth Hobs
04-07-2014, 01:07 PM
Set the application's calculation mode to manual and then back to what it was? See: http://vbaexpress.com/kb/getarticle.php?kb_id=1035

Paul_Hossler
04-07-2014, 01:46 PM
thanks Ken, but that doesn't seem to be the issue

It appears that a [Replace All] files the WS_Change event of each cell being changed (which is reasonable I suppose)

In the attachment if you select Cols A and B, and then a manual control-H to replace all, each cell is changed and the event fires for each cell.

In my F&R macro I can control it, but a control-H is under Excel's control and the events get turned on and off for each cell

Some times there can be 1000's of affected cells.

Before the user doing a F&R EnableEvents = True and ScreenUpdating = True, so a UI initiated F&R starts in that state. I tried to replace or intercept the built-in F&R command to 'wrap' it and turn then off, but could get it working

Hope this is clearer

Paul

snb
04-07-2014, 02:00 PM
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A:B")) Is Nothing Then Exit Sub
If Selection.Address = Cells(1).CurrentRegion.Resize(, 2).Address Then Exit Sub

Application.EnableEvents = False
Application.ScreenUpdating = False

For Each c In r.Intersect(Target, Cells(1).CurrentRegion.Resize(, 2)).SpecialCells(2, 1)
c.Value = UCase(c.Value)
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

The reamarkable thing is: the replacement takes place without triggering the worksheet_change event. After the replacement is complete the change-event will be triggered as many times as replacements have taken place.

Paul_Hossler
04-07-2014, 02:08 PM
The remarkable thing is: the replacement takes place without triggering the worksheet_change event. After the replacement is complete the change-event will be triggered as many times as replacements have taken place.


Yea - I'd say Wierd.

With ScreenUpdating=False you can see that the WS is updated, and then the event fires for each cell that was updated

That's what was confusing me

Thanks for confirming

Paul

Kenneth Hobs
04-07-2014, 02:24 PM
I'll have to think about this one. This is sort of interesting.

Private Sub Worksheet_Change(ByVal Target As Range)
Debug.Print Target.Address

Dim r As Range, c As Range

If Intersect(Target, Range("A:B")) Is Nothing Then Exit Sub

Set r = Intersect(Target, Target.Parent.UsedRange, Target.Parent.Range("A:B"))

Application.EnableEvents = False
Application.ScreenUpdating = False

For Each c In r.Cells
c.Value = UCase(c.Value)
Next

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Paul_Hossler
04-09-2014, 05:41 PM
Ken -- any insights?

Sometimes I have to F&R all to 100's of lines, and it really takes a lot longer and the screen flicker is annoying

Paul

Aflatoon
04-10-2014, 05:48 AM
I don't think there's much you can do besides intercepting the commands yourself. There's nothing the event can do about being called multiple times - other than maybe turn events off, then use OnTime to reinstate them a second or so later.

Paul_Hossler
04-10-2014, 05:56 AM
I don't think there's much you can do besides intercepting the commands yourself.


I actually thought about that since I'd seen code for replacing Copy/Paste.

I gave up because there's so many ways a F&R can be started.

If you have any ideas, be glad to hear them

Paul

Aflatoon
04-10-2014, 06:55 AM
You'd need Onkey for the Ctrl+H shortcut and the RibbonX would be something like:

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui"> <commands> <command idMso="ReplaceDialog" onAction="myReplace"/> </commands></customUI>
which I think would override all Replace buttons, wherever they are located.

SamT
04-10-2014, 07:07 AM
I gave up because there's so many ways a F&R can be started.
What besides the Edit Menu and Ctrl+H ?

I can't find my CommandBars Reference workbook, but I thimk that you wold only have to change the "command" for the Replace Button on the Edit CommandBar to call your own F&R code. :dunno

Paul_Hossler
04-10-2014, 03:55 PM
What besides the Edit Menu and Ctrl+H ?

I can't find my CommandBars Reference workbook, but I think that you would only have to change the "command" for the Replace Button on the Edit CommandBar to call your own F&R code. :dunno


@SamT -- Ok, Ok, Ok .. so maybe it's only 2 places:*)

If you can find theCommandBars reference AND a bit of code that would be useful ... please

@Aflatoon -- I sort of considered the CustomUI approach, but didn't do too much experimenting

1. Replace Excel's with my Sub in the CustomUI
2. If on the correct sheet, .EnableEvents = False, show Application.Dialogs(xlDialogFormulaReplace), do it, and turn events on afterwards
3. If not on the correct sheet, just do Application.Dialogs(xlDialogFormulaReplace)

The Application.Dialogs(xlDialogFormulaReplace) dialog is different than the Control-H and the Excel version (no [Options] button) but I guess I could live with that





Sub MyFR()
Dim dglFindReplace As Dialog

'find_text, replace_text, look_at, look_by, active_cell, match_case, match_byte

Set dglFindReplace = Application.Dialogs(xlDialogFormulaReplace)
dglFindReplace.Show
End Sub


Thoughts?

Paul

PS: still doesn't explain Excel's Replacing a number of cells, and then firing the event for each cell, one at a time

Aflatoon
04-10-2014, 04:20 PM
If you wanted, you could probably set a windows timer in the Ribbon command callback that disables events, then waits for the replace dialog and sets another timer waiting for the message box that appears after the replace operation (or hook the message box), to then reset events. Could be fun. :)

I can ask why it behaves that way but I'd be surprised if I got an answer to be honest.

ZVI
04-10-2014, 06:43 PM
Put any volatile function in the cell like =TODAY() and try this code:


Dim IsOk As Boolean

Private Sub Worksheet_Calculate()
IsOk = False
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

If IsOk Then Exit Sub

' Your code is here
' ...

IsOk = True

End Sub

SamT
04-11-2014, 06:28 AM
@SamT -- Ok, Ok, Ok .. so maybe it's only 2 places:*)
Dang, I thought I was gonna learn a secret :crying:

snb
04-11-2014, 08:58 AM
All macros in the codemodule of sheet1:


Sub M_snb()
Application.OnKey "^h", "sheet1.vervang"
End Sub

Sub vervang()
Application.EnableEvents = False

Selection.Name = "snb_002"
[snb_002] = [index(substitute(snb_002,"qq","zz"),)]
ThisWorkbook.Names("snb_002").Delete

Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox "kkk"
End Sub

Without the application.enableevents=false it triggers the worksheet_change event only once.

Paul_Hossler
04-11-2014, 02:45 PM
@ZVI & snb -- thanks but I don't think that's getting to the problem

Per #1, I have a WS_Change event to make inputs into upper case. That works fine (paste in or control-enter, it runs on cell at a time also)

If the user does a F&R on that sheet, the cells get updated and THEN the event fires for every cell that was changed, one cell at a time

events off, make upper case, events on

repeat for each cell

Paul

snb
04-12-2014, 03:55 AM
I think it does: it replaces the values in a selected range without triggering the change event.
The result however will be exactly the same as that resulting form using the builtin find/replace facility.

Paul_Hossler
04-12-2014, 05:22 AM
The result however will be exactly the same as that resulting form using the builtin find/replace facility.


That part I understand but the F&R parameters are not in the code.

The issue is that with the WS_Change event loaded and active, when the user uses the ribbon button or Ctrl-H to enter "Find: cat, Replace: dog, [Replace All] then the changes are applied apparently all at once, and then the event fires for each cell

Changing using keyboard one or two cells is tolerable, but a [Replace All] with 100's or 1000's to update takes a long time




the cells get updated and THEN the event fires for every cell that was changed, one cell at a time
events off, make upper case, events on
repeat for each cell


Paul

snb
04-12-2014, 07:11 AM
I posted the code to illustrate how to avoid the triggering of the change event.


Sub vervang()
Application.EnableEvents = False

c00 = InputBox("Find", "Find & Replace")
c01 = InputBox("Replace " & c00 & " by", "Find & Replace")
Selection = Evaluate("index(substitute(" & selection.address & ",""" & c00 & """,""" & c01 & """),)")

Application.EnableEvents = True
End Sub

I wasn't able to retrieve the dialogs(130) arguments.

GTO
04-12-2014, 12:29 PM
...In my F&R macro I can control it, but a control-H is under Excel's control and the events get turned on and off for each cell

Some times there can be 1000's of affected cells.

Before the user doing a F&R EnableEvents = True and ScreenUpdating = True, so a UI initiated F&R starts in that state. I tried to replace or intercept the built-in F&R command to 'wrap' it and turn then off, but could get it working...

Hi Paul,

I am sure you meant you could not get it working. I just am not utterly sure about a couple of points:


If the user replaces a cell-at-a-time, you want the Worksheet_Change to run; is that correct?
Only if the user selects <Replace All> button do we want Worksheet_Change blocked, is that correct?


Now only if I got those two correct, this question: After all the replacements are made, is the stuff actually in your current Worksheet_Change event still needing done, or are we just skipping it?

Mark

ZVI
04-12-2014, 03:42 PM
Hi Paul,
If issue is in a slow converting via the code to upper case at applying of F&R - [Replace All]
then put in any cell formula =TODAY() ( its format can be: ;;; ) and try this code:


' Put all the below code to the sheet's module
Option Explicit

Dim MyRng As Range

' Collect all Target in MyRng variable
Private Sub Worksheet_Change(ByVal Target As Range)
If MyRng Is Nothing Then
Set MyRng = Target
Else
Set MyRng = Union(MyRng, Target)
End If
End Sub

' Convert values of MyRange to upper case
Private Sub Worksheet_Calculate()

If MyRng Is Nothing Then Exit Sub

' Trap errors
On Error GoTo exit_

' Speed up the code
With Application
.EnableEvents = False
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

' Main
Dim a, Area As Range
Dim c As Long, r As Long
For Each Area In MyRng.Areas
With Area
a = .Value
If IsArray(a) Then
For r = 1 To UBound(a, 1)
For c = 1 To UBound(a, 2)
If VarType(a(r, c)) = vbString Then
a(r, c) = UCase(a(r, c))
End If
Next
Next
.Value = a
Else
If VarType(a) = vbString Then
.Value = UCase(a)
End If
End If
End With
Next

exit_:

' Unfreeze Excel
With Application
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

' Reset MyRng variable
Set MyRng = Nothing

End Sub

Vladimir

Paul_Hossler
04-13-2014, 01:55 PM
1. The WS_Change event will do other things on the range of changed cells, making text into UC is just a simple example that can stand-alone in the example

2. The normal / usual / common way to structure event handlers to avoid recursion is to turn off Application.EnableEvents, do what needs to be done, and the turn events back on

3. Enter or Control-Enter a single cell or small number of cells being updated do not cause an issue

4. Doing a F&R is different and not very fast

This is the handler code



Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Debug.Print "Events Off for " & Target.Parent.Name
For Each r In Target.Cells
Debug.Print "Event for " & r.Address
r.Value = UCase(r.Value)
Next
Debug.Print "Events On for " & Target.Parent.Name
Debug.Print "----------------------------------------"

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub




A. If I Enter, Control-Enter (say 5000 cells = "aaaa"), or Paste onto Sheet 1, I get



Events Off for Sheet1
Event for $A$1
Event for $A$2
Event for $A$3
Event for $A$4
Event for $A$5
Event for $A$31
Event for $A$32
Event for $A$33
Events On for Sheet1
----------------------------------------



However, if I then select a group, of those and do a F&R [Replace All] then it's on/off/on/off/ ...



Events Off for Sheet1
Event for $A$1
Events On for Sheet1
----------------------------------------
Events Off for Sheet1
Event for $A$2
Events On for Sheet1
----------------------------------------
Events Off for Sheet1
Event for $A$3
Events On for Sheet1
----------------------------------------
Events Off for Sheet1
Event for $A$4
Events On for Sheet1
----------------------------------------
Events Off for Sheet1
Event for $A$5
Events On for Sheet1
----------------------------------------
Events Off for Sheet1
Event for $A$6
Events On for Sheet1
----------------------------------------
Events Off for Sheet1
Event for $A$7
Events On for Sheet1
----------------------------------------



Sorry if I confused anyone, but it's not a question of making upper case or replacing something from the macro;

The issue is when the user does a F&R with ANY find text to make it into ANY replace text, the event handlers fires for EVERY cell that is changed; Screen flickers, and goes 'Not Responding' for a while


@Mark -

For enter, control-enter, and paste the way it works is fine.

For a F&R, you can see (remove ScreenUpdating = False) the cells are updated very fast, BUT THEN the handler fires for each cell. That situation causes the problems

If there were a way to intercept the F&R, bypass the event handling, that's probably the best I can expect. Not perfect, but an improvement.



This seems to work (I don't have a LOT of faith in it) and I had to make Sheet1.Worksheet_Change not Private. I can replace the Ribbon callback (SamT's post) and make .OnKey for control-H call mine instead, but it still seems like I'm over complicating it



Sub myFR()
Dim dlg As Dialog
Dim r As Range

Set dlg = Application.Dialogs(xlDialogFormulaReplace)

Application.EnableEvents = False

If dlg.Show = True Then
Call Sheet1.Worksheet_Change(Selection)
End If

Application.EnableEvents = True
End Sub






Paul

SamT
04-13-2014, 07:33 PM
This fellow says that using Find...FindNext is faster than the the F&R Dialog
http://social.msdn.microsoft.com/Forums/vstudio/en-US/293217af-6c12-4ed2-9021-8eefa71aa98a/excel-need-fast-search-and-replace-capability?forum=vsto

GTO
04-13-2014, 09:22 PM
If you wanted, you could probably set a windows timer in the Ribbon command callback that disables events, then waits for the replace dialog and sets another timer waiting for the message box that appears after the replace operation (or hook the message box), to then reset events. Could be fun. :)

I can ask why it behaves that way but I'd be surprised if I got an answer to be honest.

Hi Aflatoon,

It wasn't. :crying:


I'm sure my efforts are rudimentary, but added to the below code, I nested the IF, so if it found the dialog, then if it found a message box, enumerate the controls, looking for part of the correct message; like:


If lpClassName = "MSOUNISTAT" And InStr(1, sWinText, "Excel has completed") > 0 Then...

...this was to overcome mis-identifying for the "Excel cannot find" messagebox.

Anyways, when I tried changing EnableEvents upon discovering the messagebox in existence, Excel ungraciously becomes most offended and leaves the party. More trys than it should have taken me, but I believe (if I am wrong, please correct me, but this was repeated observations and tacking in the FSO to write script as the code executes, so I could see what line offends her so much) that as the messagebox is modal, trying to change EnableEvents in the callback falls over in a big way.


@Mark -

For enter, control-enter, and paste the way it works is fine.

For a F&R, you can see (remove ScreenUpdating = False) the cells are updated very fast, BUT THEN the handler fires for each cell. That situation causes the problems

If there were a way to intercept the F&R, bypass the event handling, that's probably the best I can expect. Not perfect, but an improvement.


Hi Paul,

Most definitely experimental, as I haven't been able to test well enough. So of course in a throwaway copy...

ThisWorkbook Module:

Option Explicit

Private Sub Workbook_Activate()

If TypeName(ActiveSheet) = "Worksheet" Then
If ActiveSheet.CodeName = "Sheet1" Then
StartDetectFindAndReplace
End If
End If

End Sub

Private Sub Workbook_Deactivate()

EndDetectFindAndReplace

End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

If TypeName(ActiveSheet) = "Worksheet" Then
If ActiveSheet.CodeName = "Sheet1" Then
StartDetectFindAndReplace
End If
End If

End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)

If TypeName(ActiveSheet) = "Worksheet" Then
If Not ActiveSheet.CodeName = "Sheet1" Then
EndDetectFindAndReplace
End If
End If

End Sub

Standard Module:

Option Explicit

'*Private Declare Function GetTickCount Lib "kernel32" () As Long 'debug
Private Declare Function SetTimer Lib "user32" (ByVal Hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal Hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal Hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal Hwnd As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal Hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Const DIALOGCLASSNAME As String = "bosa_sdm_XL9"
Private Const DIALOGCAPTION As String = "Find and Replace"
Private Const MSGCLASSNAME As String = "#32770"
Private Const MSGCAPTION As String = "Microsoft Excel"

Private Const TMR01ID As Long = 1
Private Const TMR01ELAPSE As Long = 500

Private hwndExcelApp As Long
Private hwndFRDialog As Long
Private hwndMsgDialog As Long

Private bolChangeEventDisabled As Boolean
Private bolIsActiveTimer01 As Boolean

'// Debug/Temp //
'*Private FSO As Scripting.FileSystemObject
'*Private fsoDebug As Scripting.TextStream
'*Private TimeHack As Long

Public Sub StartDetectFindAndReplace()
Dim lTimer01Ret As Long

'*TimeHack = GetTickCount 'debug
'*Set FSO = CreateObject("Scripting.FileSystemObject") 'debug
'*Set fsoDebug = FSO.CreateTextFile(Filename:=ThisWorkbook.Path & "\DebugAPI.txt", _
Overwrite:=True) 'debug

'// If Excel2000 see: http://www.informit.com/articles/article.aspx?p=366892&seqNum=3 //
hwndExcelApp = Application.Hwnd

lTimer01Ret = SetTimer(hwndExcelApp, TMR01ID, TMR01ELAPSE, AddressOf Timer01Proc01)
bolIsActiveTimer01 = CBool(lTimer01Ret)
'*fsoDebug.WriteLine "Timer01 started = " & bolIsActiveTimer01 'debug

End Sub

Public Sub EndDetectFindAndReplace()
Dim lKillTimerRet As Long

If bolIsActiveTimer01 Then
lKillTimerRet = KillTimer(hwndExcelApp, TMR01ID)
bolIsActiveTimer01 = False
'*fsoDebug.WriteLine "Timer01 ended = " & Not bolIsActiveTimer01 'debug
'*fsoDebug.Close 'debug
End If

End Sub

Private Sub Timer01Proc01(ByVal Hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
Dim lEnumRet As Long

hwndFRDialog = 0
hwndFRDialog = FindWindow(DIALOGCLASSNAME, DIALOGCAPTION)
If Not hwndFRDialog = 0 Then

'*fsoDebug.WriteLine "FR dialog found: " & (GetTickCount - TimeHack) 'debug

If Application.EnableEvents Then
bolChangeEventDisabled = True
Application.EnableEvents = False
DoEvents
End If

Else

'*fsoDebug.WriteLine "Timer01Proc01 called: " & (GetTickCount - TimeHack) 'debug

If bolChangeEventDisabled Then
Application.EnableEvents = True
bolChangeEventDisabled = False
DoEvents
End If

End If

End Sub


If that seems like anything interesting, maybe see if there are any conditions that goof it up. Seems to work in minimal testing.

Mark

Aflatoon
04-14-2014, 12:36 AM
Mark,
Well it looks like it was fun to me! ;)
Nice job. (Can't test it as I'm on holiday and wife will kill me if I boot up my laptop)

GTO
04-14-2014, 01:02 AM
Thanks Aflatoon,

We'll have to see how 'nice', as I figure there's probably at least a couple of ways I'm not yet seeing for hiccups.

Hope you and your bride have a great time!

Mark

PS - I'm sticking with 'nope', it always makes me edgy when stuff turns a ghastly color and things stop responding...:ack:

Paul_Hossler
04-14-2014, 05:05 AM
Mark -- thanks !!! I will experiment with it when I get a chance, prob later this week (darn work keeps getting in the way)

So far it looks like a lot of effort to get around what I thought was a lack of knowledge on my part about the way to get it to work better.

Appreciate everyone's efforts

Paul