PDA

View Full Version : Solved: Need help regarding formatting sting using VBA



pradeepdeepu
02-11-2013, 04:17 AM
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.

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


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

Can anyone please :help me on this.

Thanks in advance.

Kenneth Hobs
02-11-2013, 12:33 PM
Find the ranges and then change values and such.

e.g.
'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

pradeepdeepu
02-11-2013, 07:54 PM
Kenneth Hobs,

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