Solved: Need help regarding formatting sting using VBA

[pradeepdeepu]

I'm currently using a macro/VBA to find and replace string in word document from excel data.

This code is working fine for me.
[VBA]
Dim xlApp 'As Excel.Application
Dim xlWB 'As Excel.Workbook
Dim idx As Integer
Set xlApp = CreateObject("Excel.Application")
Set xlWB = xlApp.Workbooks.Open("C:\Desktop\Replacelist.xlsx")
For idx = 1 To 500
'MsgBox "Replacing " & xlWB.Worksheets(1).Cells(idx, 1) & " by " & xlWB.Worksheets(1).Cells(idx, 2)
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = xlWB.Worksheets(1).Cells(idx, 1)
.Replacement.Text = xlWB.Worksheets(1).Cells(idx, 2)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = True
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False

End With
Selection.Find.Execute Replace:=wdReplaceAll

Next
xlWB.Close False
xlApp.Quit
Set xlWB = Nothing
Set xlApp = Nothing
[/VBA]

But i want the replaced string to be formatted with Red color font, Italics and underlined.

Can anyone please me on this.

Thanks in advance.

[Kenneth Hobs]

Find the ranges and then change values and such.

e.g.
[VBA]'xld, http://www.vbaexpress.com/forum/showthread.php?t=38802, see module, mDeleteRowsFromBottomUp

' Chip Pearson, http://www.cpearson.com/excel/FindAll.aspx

'Kenneth, http://www.vbaexpress.com/forum/showthread.php?t=38802
Sub Test_FoundRanges()
Dim findRange As Range, findString As String, foundRange As Range
Dim r As Range, i As Long

On Error GoTo EndNow:
'http://vbaexpress.com/kb/getarticle.php?kb_id=1035
SpeedOn

Set findRange = ActiveSheet.Range("A1:A" & ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row)
findString = "Allocation"
Set foundRange = FoundRanges(findRange, findString)
If foundRange Is Nothing Then GoTo EndNow

'If Not foundRange Is Nothing Then MsgBox foundRange.Address 'Note that range is in reverse order
'If Not foundRange Is Nothing Then foundRange.EntireRow.Delete
'For i = i to foundRange.Areas.Count
' foundRange.Areas(i).EntireRow.Delete
'Next i

EndNow:
SpeedOff
End Sub

Function FoundRanges(fRange As Range, fStr As String) As Range
Dim objFind As Range
Dim rFound As Range, FirstAddress As String

With fRange
Set objFind = .Find(what:=fStr, After:=fRange.Cells((fRange.Rows.Count), fRange.Columns.Count), _
LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=True)
If Not objFind Is Nothing Then
Set rFound = objFind
FirstAddress = objFind.Address
Do
Set objFind = .FindNext(objFind)
If Not objFind Is Nothing Then Set rFound = Union(objFind, rFound)
Loop While Not objFind Is Nothing And objFind.Address <> FirstAddress
End If
End With
Set FoundRanges = rFound
End Function[/VBA]

[pradeepdeepu]

Kenneth Hobs,

Thank you for your reply, I will try your suggestions.