Looking for a quick way.
After I posted, I realized that going cell by cell would be a waste if most
cells don't have parentheses in them.
Option Explicit
Sub testme()
Dim myRng As Range
Dim myCell As Range
Dim StartPos As Long
Dim LastPos As Long
Dim FoundCell As Range
Dim FirstAddress As String
Dim AllFoundCells As Range
Set myRng = Selection
With myRng
Set FoundCell = .Find(what:="(", _
LookIn:=xlValues, lookat:=xlPart, _
after:=.Cells(.Cells.Count))
If FoundCell Is Nothing Then
MsgBox "Nothing to fix"
Else
Set AllFoundCells = FoundCell
FirstAddress = FoundCell.Address
Do
If AllFoundCells Is Nothing Then
Set AllFoundCells = FoundCell
Else
Set AllFoundCells = Union(FoundCell, AllFoundCells)
End If
Set FoundCell = .FindNext(FoundCell)
If FoundCell.Address = FirstAddress Then
Exit Do
End If
Loop
For Each myCell In AllFoundCells.Cells
StartPos = InStr(1, myCell.Value, "(", vbTextCompare)
LastPos = InStr(1, myCell.Value, ")", vbTextCompare)
If LastPos 0 Then
If StartPos < LastPos Then
With myCell.Characters(Start:=StartPos, _
Length:=LastPos - StartPos + 1)
.Font.FontStyle = "Italic"
End With
End If
End If
Next myCell
End If
End With
End Sub
Michael Koerner wrote:
I have roughly 1200 records that I need to change (whatever is here)
including the brackets to italic Any way to do it with a quick macro or is
it going to be a one-at-a-time effort.
--
Regards
Michael Koerner
--
Dave Peterson
|