PDA

View Full Version : Display in message box



shekhu
02-16-2011, 12:10 AM
Hello,

If possible, I would like the message box in the following macro to display found character and the replace character, instead of Change this one? so that the user might know what is to be replaced by what.
Thanks for your valuable inputs.

Sub MacroRepAllWithMessage()
Dim oRng As Range, fRng As Range, i As Integer
Dim SearchArray As Variant, ReplaceArray As Variant
SearchArray = Array("Reason for visit", "data birth", "date visit")
ReplaceArray = Array("Reason for visit: ", "DATE OF BIRTH:", "DATE OF VISIT:")
With Selection
Set oRng = .Range
With .Find
.ClearFormatting
.MatchCase = True
.Highlight = False
.MatchWildcards = False
.Wrap = wdFindContinue
.Forward = True
For i = 0 To UBound(SearchArray)
.Text = SearchArray(i)
Do While .Execute = True
If Selection.Start > oRng.End Then Exit Do
Set fRng = ActiveDocument.Range(Start:=Selection.Start, End:=Selection.End)
With fRng
If MsgBox(SearchArray(i) & vbCr & vbCr & "Change this one?", vbYesNo, "Change Format") = vbYes Then
.Text = ReplaceArray(i)
.HighlightColorIndex = wdBrightGreen
.Collapse Direction:=wdCollapseEnd
End If
End With
Loop
oRng.Select
Next
End With
End With
oRng.Select
Set fRng = Nothing: Set oRng = Nothing
End Sub

Tinbendr
02-17-2011, 07:51 AM
How about this?
Sub MacroRepAllWithMessage()
Dim oRng As Range, fRng As Range, i As Integer
Dim Msg As String
Dim SearchArray As Variant, ReplaceArray As Variant
SearchArray = Array("Reason for visit", "data birth", "date visit")
ReplaceArray = Array("Reason for visit: ", "DATE OF BIRTH:", "DATE OF VISIT:")
With Selection
Set oRng = .Range
With .Find
.ClearFormatting
.MatchCase = True
.Highlight = False
.MatchWildcards = False
.Wrap = wdFindContinue
.Forward = True
For i = 0 To UBound(SearchArray)
.Text = SearchArray(i)
Do While .Execute = True
If Selection.Start > oRng.End Then Exit Do
Set fRng = ActiveDocument.Range(Start:=Selection.Start, End:=Selection.End)
With fRng
Msg = "Found Character " & SearchArray(i) & vbCr _
& "Replace Character? " & ReplaceArray(i)
If MsgBox(Msg, vbYesNo, "Change Format") = vbYes Then
.Text = ReplaceArray(i)
.HighlightColorIndex = wdBrightGreen
.Collapse Direction:=wdCollapseEnd
End If
End With
Loop
oRng.Select
Next
End With
End With
oRng.Select
Set fRng = Nothing: Set oRng = Nothing
End Sub

shekhu
02-17-2011, 10:44 PM
Thanks a lot David, this is great.:clap: