Find and Replace text with formatting

[Harry-Wishes]

I am trying to write a script that will find any numeric supscripts or
superscripts in any cells of the activate worksheet and replace it with
another character. I have not been able to do this successfully in Excel even
when I do this manually through Excel's find and replace. It works when I
remove the filter that restricts the search to just characters that are super
or subscripted in a cell.

I have no trouble doing this in Word as you can see from the snippit I used
below for one of my Word projects. Is their an Excel equivalent?

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "([0-9]{1,2})"
.Replacement.Text = "|\1|"
.Forward = True
.Wrap = wdFindwdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
While Selection.Find.Execute

If Selection.Font.Superscript = True Then
Selection.Find.Execute Replace:=wdReplaceOne
Selection.MoveRight Unit:=wdCharacter, count:=1

End If
With Selection.Find
.Text = "([0-9]{1,2})"
.Replacement.Text = "|\1|"
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Wend


Thanks.

Harry Wishes

 

[Dave Peterson]

Excel won't work this way.

You could use Edit|Find (in xl2002 and higher) to search for subscripts, then
loop through each of those cells and then do a character by character inspection
to do your replace.

Then repeat for the superscripts.

I am trying to write a script that will find any numeric supscripts or
superscripts in any cells of the activate worksheet and replace it with
another character. I have not been able to do this successfully in Excel even
when I do this manually through Excel's find and replace. It works when I
remove the filter that restricts the search to just characters that are super
or subscripted in a cell.

I have no trouble doing this in Word as you can see from the snippit I used
below for one of my Word projects. Is their an Excel equivalent?

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "([0-9]{1,2})"
.Replacement.Text = "|\1|"
.Forward = True
.Wrap = wdFindwdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
While Selection.Find.Execute

If Selection.Font.Superscript = True Then
Selection.Find.Execute Replace:=wdReplaceOne
Selection.MoveRight Unit:=wdCharacter, count:=1

End If
With Selection.Find
.Text = "([0-9]{1,2})"
.Replacement.Text = "|\1|"
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Wend

Thanks.

Harry Wishes

 

[Harry-Wishes]

Thanks Dave

I see what you mean by analyzing the contents of each cell for every cell in
the worksheet. I have a skeleton below. I just need some meat on those bones.

Thanks for the advice

Harrry Wishes


Sub evaluate_cell()

Dim string_len As Integer
string_len = Len(ActiveCell)

For m = 1 To string_len
If ActiveCell.Characters(Start:=m,
Length:=string_len).Font.Superscript = True
Then
MsgBox "It is a superscript. Do something"
Else
MsgBox "Nothing to do. Not really"
End If
Next m


End Sub

Excel won't work this way.

You could use Edit|Find (in xl2002 and higher) to search for subscripts, then
loop through each of those cells and then do a character by character inspection
to do your replace.

Then repeat for the superscripts.

I am trying to write a script that will find any numeric supscripts or
superscripts in any cells of the activate worksheet and replace it with
another character. I have not been able to do this successfully in Excel even
when I do this manually through Excel's find and replace. It works when I
remove the filter that restricts the search to just characters that are super
or subscripted in a cell.

I have no trouble doing this in Word as you can see from the snippit I used
below for one of my Word projects. Is their an Excel equivalent?

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "([0-9]{1,2})"
.Replacement.Text = "|\1|"
.Forward = True
.Wrap = wdFindwdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
While Selection.Find.Execute

If Selection.Font.Superscript = True Then
Selection.Find.Execute Replace:=wdReplaceOne
Selection.MoveRight Unit:=wdCharacter, count:=1

End If
With Selection.Find
.Text = "([0-9]{1,2})"
.Replacement.Text = "|\1|"
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Wend

Thanks.

Harry Wishes

 

[Dave Peterson]

Saved from a previous post:

Option Explicit
Option Compare Text
Sub testme()

Application.ScreenUpdating = False

Dim myWords As Variant
Dim myRng As Range
Dim foundCell As Range
Dim iCtr As Long 'word counter
Dim cCtr As Long 'character counter
Dim FirstAddress As String
Dim AllFoundCells As Range
Dim myCell As Range

'add other words here
myWords = Array("widgets", "assemblies", "another", "word", "here")

Set myRng = Selection

On Error Resume Next
Set myRng = Intersect(myRng, _
myRng.Cells.SpecialCells(xlCellTypeConstants, xlTextValues))
On Error GoTo 0

If myRng Is Nothing Then
MsgBox "Please choose a range that contains text constants!"
Exit Sub
End If

For iCtr = LBound(myWords) To UBound(myWords)
FirstAddress = ""
Set foundCell = Nothing
With myRng
Set foundCell = .Find(what:=myWords(iCtr), _
LookIn:=xlValues, lookat:=xlPart, _
after:=.Cells(1))

If foundCell Is Nothing Then
MsgBox myWords(iCtr) & " wasn't found!"
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)

Loop While Not foundCell Is Nothing _
And foundCell.Address <> FirstAddress
End If

End With

If AllFoundCells Is Nothing Then
'do nothing
Else
For Each myCell In AllFoundCells.Cells
For cCtr = 1 To Len(myCell.Value)
If Mid(myCell.Value, cCtr, Len(myWords(iCtr))) _
= myWords(iCtr) Then
With myCell.Characters(Start:=cCtr, _
Length:=Len(myWords(iCtr)))
.Font.ColorIndex = 3
.Font.Bold = True
End With
End If
Next cCtr
Next myCell
End If
Next iCtr
Application.ScreenUpdating = True

End Sub

This portion:

With myCell.Characters(Start:=cCtr, _
Length:=Len(myWords(iCtr)))
.Font.ColorIndex = 3
.Font.Bold = True
End With

Changes the color and the boldness.

It doesn't do what you want, but maybe you can flesh it out.

Record a macro that looks for subscript (to get the syntax correct). That code
will replace the .find line based on words.

Then instead of looking through the characters looking for a string, you'll have
to look for the subscript.

Thanks Dave

I see what you mean by analyzing the contents of each cell for every cell in
the worksheet. I have a skeleton below. I just need some meat on those bones.

Thanks for the advice

Harrry Wishes

Sub evaluate_cell()

Dim string_len As Integer
string_len = Len(ActiveCell)

For m = 1 To string_len
If ActiveCell.Characters(Start:=m,
Length:=string_len).Font.Superscript = True
Then
MsgBox "It is a superscript. Do something"
Else
MsgBox "Nothing to do. Not really"
End If
Next m

End Sub

Excel won't work this way.

You could use Edit|Find (in xl2002 and higher) to search for subscripts, then
loop through each of those cells and then do a character by character inspection
to do your replace.

Then repeat for the superscripts.

I am trying to write a script that will find any numeric supscripts or
superscripts in any cells of the activate worksheet and replace it with
another character. I have not been able to do this successfully in Excel even
when I do this manually through Excel's find and replace. It works when I
remove the filter that restricts the search to just characters that are super
or subscripted in a cell.

I have no trouble doing this in Word as you can see from the snippit I used
below for one of my Word projects. Is their an Excel equivalent?

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "([0-9]{1,2})"
.Replacement.Text = "|\1|"
.Forward = True
.Wrap = wdFindwdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
While Selection.Find.Execute

If Selection.Font.Superscript = True Then
Selection.Find.Execute Replace:=wdReplaceOne
Selection.MoveRight Unit:=wdCharacter, count:=1

End If
With Selection.Find
.Text = "([0-9]{1,2})"
.Replacement.Text = "|\1|"
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Wend

Thanks.

Harry Wishes