How to introduce delay so that user can see the changes being made?

[SFRandy]

I have code that removes extra spaces. The user is prompted for each change. When they user agrees to the change, I would like to make the change, then pause for 1/2 second to allow the user to see what the change is before moving on to the next item to correct. This would allow them to cancel out of the program and undo the change if they disagree with it.

How can I introduce this 1/2 second delay?



' Turn on screen updating
Application.ScreenUpdating = True

' Remove spaces before paragraph marks
mySearchRegExpression = " {1,}^013"
With Selection.Find
.ClearFormatting

Do While .Execute(findText:=mySearchRegExpression, MatchWildcards:=True, Forward:=True, Wrap:=wdFindContinue) = True
result = MsgBox("Remove extra space(s)?", vbYesNoCancel)
If result = vbYes Then
Selection.TypeParagraph ' This works just like hitting the enter key
ElseIf result = vbNo Then
' MsgBox "You clicked No"
Else
GoTo EndOfFunction
End If

findCounter = findCounter + 1
Loop
End With

[HTSCF Fareha]

I'm not sure if this will be of any help?

https://answers.microsoft.com/en-us/msoffice/forum/msoffice_word-msoffice_custom-mso_2010/how-to-add-delay-of-5-seconds-using-vba/5d67b0dd-b281-4134-b436-538d12e37424

[SamT]

Do While .Execute(findText:=mySearchRegExpression, MatchWildcards:=True, Forward:=True, Wrap:=wdFindContinue) = True
'Set Variable to " " location in Selection
result = MsgBox("Remove extra space(s)?", vbYesNoCancel)
If result = vbYes Then
Selection.TypeParagraph ' This works just like hitting the enter key
ElseIf result = vbNo Then
' Replace Variable (" ") with " "
End If
Loop

[Paul_Hossler]

One way




Option Explicit


Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


Sub Wait()


Msgbox "Before"
Sleep 500
Msgbox "After"


End Sub

[gmayor]

The process will pause until you respond to the message box. Your problem appears to be that you can't see the found item. This should fix it.



Do While .Execute(findText:=mySearchRegExpression, _ MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindContinue) = True
Application.ScreenRefresh
Result = MsgBox("Remove extra space(s)?", vbYesNoCancel)
If Result = vbYes Then
Selection.TypeParagraph ' This works just like hitting the enter key
ElseIf Result = vbNo Then
GoTo NextFind
Else
GoTo EndOfFunction
End If
findcounter = findcounter + 1
NextFind:
Loop

[SFRandy]

Thank you, all! The solution that worked for me ended up being a combination of the suggestions you all provided. Changes I made are in red below. As a result, the change is made, the technique pauses for a bit, then moves onto selecting the next item that is proposed to be changed.


Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

' Turn on screen updating
Application.ScreenUpdating = True

' Remove spaces before paragraph marks
mySearchRegExpression = " {1,}^013"
With Selection.Find
.ClearFormatting

Do While .Execute(findText:=mySearchRegExpression, MatchWildcards:=True, Forward:=True, Wrap:=wdFindContinue) = True
result = MsgBox("Remove extra space(s)?", vbYesNoCancel)
If result = vbYes Then
Selection.TypeParagraph ' This works just like hitting the enter key
Application.ScreenRefresh
Sleep 250 ' Give user time to see the change
ElseIf result = vbNo Then
' MsgBox "You clicked No"
Else
GoTo EndOfFunction
End If

findCounter = findCounter + 1
Loop
End With

[macropod]

I'd approach this rather differently:

Sub Demo()
Dim Rslt
With ActiveDocument.Range
With .Find
.ClearFormatting
.Text = "^w^p"
.Wrap = wdFindStop
.Forward = True
.MatchWildcards = False
End With
Do While .Find.Execute = True
.Select
Rslt = MsgBox("Remove extra space(s)?", vbYesNoCancel)
Select Case Rslt
Case vbYes
.Text = vbCr
Application.ScreenRefresh
If MsgBox("Keep This Change?", vbYesNo) = vbNo Then ActiveDocument.Undo
Case vbNo
Case vbCancel: Exit Do
End Select
.Collapse wdCollapseEnd
Loop
End With
End Sub