Thank you all! That's what I need.

However your macro distorts all the formatting in colum B.

I tested both macros on this file:
http://rapidshare.com/files/9898670/Before.xls.html
and ended up with this:
http://rapidshare.com/files/9899030/After.xls.html

Can the macro be amended to preserve the original formatting?

Thanks again!

Hi Gary's Student,

I try to process the file uploaded he
http://rapidshare.com/files/9898670/Before.xls.html

The B column contains dictionary entry with bold italic and red text.

When I run any of the above suggested macros, all formatting (bold and
italic) in the dictionary entrries is removed and the font of the whole
entry turns in red.

For reference, I uploaded the file with the distorted formatting he
http://rapidshare.com/files/9899030/After.xls.html

Thanks for your help!

Gary''s Student íàïèñà:
What kind of distortion do you see. I tried:

hat I need a ~
cat please feed the~ and dog
mat put ~ on the floor
bat you have ~ in the belfry


with B1 bold
with B2 italics
with B3 underlined
with B4 having a yellow background color

After the macro runs I see:

hat I need a hat
cat please feed thecat and dog
mat put mat on the floor
bat you have bat in the belfry


with formats in column B perserved.
--
Gary's Student


" wrote:

Thank you all! That's what I need.

However your macro distorts all the formatting in colum B.

I tested both macros on this file:
http://rapidshare.com/files/9898670/Before.xls.html
and ended up with this:
http://rapidshare.com/files/9899030/After.xls.html

Can the macro be amended to preserve the original formatting?

Thanks again!

Hi Tom,

Your solution works (a bit slower but works!). It retains the bold and
red color font but the italic formatting was removed. Can this be
corrected?


Tom Ogilvy íàïèñà:
This is pretty slow, but does what you want. It shows what cell it is
working on in the status bar at the bottom left. The last processed cell
should be in the upper left corner of the screen.

Sub changeTilde()
Dim v1(), v2() As Boolean
Dim v1a(), v2a() As Boolean
Dim v3() As String, v3a() As String
Dim v4() As Long, v4a() As Long
Dim i As Long, j As Long
Dim k As Long, l As Long
Dim cnt As Long, cnt1 As Long
Dim cell As Range, rng As Range
Dim cell1 As Range, sStr As String
Set rng = Range(Cells(1, 1), _
Cells(Rows.Count, 1).End(xlUp))

Application.ScreenUpdating = False
For Each cell In rng
Application.StatusBar = cell.Address

Set cell1 = cell.Offset(0, 1)
If InStr(1, cell1.Value, "~", vbTextCompare) Then
Application.Goto cell, True
' cell.Interior.ColorIndex = 6
cnt = Len(cell1.Value)

ReDim v1(1 To cnt)
ReDim v2(1 To cnt)
ReDim v3(1 To cnt)
ReDim v4(1 To cnt)
For i = 1 To cnt
v1(i) = cell1 _
.Characters(i, 1).Text
v2(i) = cell1 _
.Characters(i, 1).Font.Bold
v3(i) = cell1 _
.Characters(i, 1).Font.Name
v4(i) = cell1 _
.Characters(i, 1).Font.ColorIndex

Next i

j = 0
For i = 1 To cnt
If v1(i) = "~" Then
cnt1 = cnt1 + Len(cell)
Else
cnt1 = cnt1 + 1
End If
Next i
ReDim v1a(1 To cnt1)
ReDim v2a(1 To cnt1)
ReDim v3a(1 To cnt1)
ReDim v4a(1 To cnt1)
j = 1
For i = 1 To cnt
If v1(i) = "~" Then
For k = 1 To Len(cell)
v1a(j) = cell.Characters(k, 1).Text
v2a(j) = v2(i)
v3a(j) = v3(i)
v4a(j) = v4(i)
j = j + 1
Next k
Else
v1a(j) = v1(i)
v2a(j) = v2(i)
v3a(j) = v3(i)
v4a(j) = v4(i)
j = j + 1
End If
Next i
sStr = ""
For l = 1 To cnt1
sStr = sStr & v1a(l)
Next l
cell1.Value = sStr
For l = 1 To cnt1
cell1.Characters(l, 1).Font.Bold = v2a(l)
cell1.Characters(l, 1).Font.Name = v3a(l)
cell1.Characters(l, 1).Font.ColorIndex = v4a(l)
Next l
Application.ScreenUpdating = True
Application.ScreenUpdating = False
End If
Next cell
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub

--
Regards,
Tom Ogilvy


" wrote:

Thank you all! That's what I need.

However your macro distorts all the formatting in colum B.

I tested both macros on this file:
http://rapidshare.com/files/9898670/Before.xls.html
and ended up with this:
http://rapidshare.com/files/9899030/After.xls.html

Can the macro be amended to preserve the original formatting?

Thanks again!

Sure, just follow the same pattern as for Bold.

--
Regards,
Tom Ogilvy


wrote in message
oups.com...
Hi Tom,

Your solution works (a bit slower but works!). It retains the bold and
red color font but the italic formatting was removed. Can this be
corrected?


Tom Ogilvy íàïèñà:
This is pretty slow, but does what you want. It shows what cell it is
working on in the status bar at the bottom left. The last processed cell
should be in the upper left corner of the screen.

Sub changeTilde()
Dim v1(), v2() As Boolean
Dim v1a(), v2a() As Boolean
Dim v3() As String, v3a() As String
Dim v4() As Long, v4a() As Long
Dim i As Long, j As Long
Dim k As Long, l As Long
Dim cnt As Long, cnt1 As Long
Dim cell As Range, rng As Range
Dim cell1 As Range, sStr As String
Set rng = Range(Cells(1, 1), _
Cells(Rows.Count, 1).End(xlUp))

Application.ScreenUpdating = False
For Each cell In rng
Application.StatusBar = cell.Address

Set cell1 = cell.Offset(0, 1)
If InStr(1, cell1.Value, "~", vbTextCompare) Then
Application.Goto cell, True
' cell.Interior.ColorIndex = 6
cnt = Len(cell1.Value)

ReDim v1(1 To cnt)
ReDim v2(1 To cnt)
ReDim v3(1 To cnt)
ReDim v4(1 To cnt)
For i = 1 To cnt
v1(i) = cell1 _
.Characters(i, 1).Text
v2(i) = cell1 _
.Characters(i, 1).Font.Bold
v3(i) = cell1 _
.Characters(i, 1).Font.Name
v4(i) = cell1 _
.Characters(i, 1).Font.ColorIndex

Next i

j = 0
For i = 1 To cnt
If v1(i) = "~" Then
cnt1 = cnt1 + Len(cell)
Else
cnt1 = cnt1 + 1
End If
Next i
ReDim v1a(1 To cnt1)
ReDim v2a(1 To cnt1)
ReDim v3a(1 To cnt1)
ReDim v4a(1 To cnt1)
j = 1
For i = 1 To cnt
If v1(i) = "~" Then
For k = 1 To Len(cell)
v1a(j) = cell.Characters(k, 1).Text
v2a(j) = v2(i)
v3a(j) = v3(i)
v4a(j) = v4(i)
j = j + 1
Next k
Else
v1a(j) = v1(i)
v2a(j) = v2(i)
v3a(j) = v3(i)
v4a(j) = v4(i)
j = j + 1
End If
Next i
sStr = ""
For l = 1 To cnt1
sStr = sStr & v1a(l)
Next l
cell1.Value = sStr
For l = 1 To cnt1
cell1.Characters(l, 1).Font.Bold = v2a(l)
cell1.Characters(l, 1).Font.Name = v3a(l)
cell1.Characters(l, 1).Font.ColorIndex = v4a(l)
Next l
Application.ScreenUpdating = True
Application.ScreenUpdating = False
End If
Next cell
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub

--
Regards,
Tom Ogilvy


" wrote:

Thank you all! That's what I need.

However your macro distorts all the formatting in colum B.

I tested both macros on this file:
http://rapidshare.com/files/9898670/Before.xls.html
and ended up with this:
http://rapidshare.com/files/9899030/After.xls.html

Can the macro be amended to preserve the original formatting?

Thanks again!

Hi Tom,

I added the pattern for italic and now I'm using the macro below.

Since my DB contains more than 250,000 rows, I decided to split it into
smaller parts to process it with this macro because the speed is very
slow.

Thank you all for your help!

Here is the macro:

===================

Sub changeTilde()
Dim v1(), v2(), v5() As Boolean
Dim v1a(), v2a() As Boolean
Dim v3() As String, v3a() As String
Dim v4() As Long, v4a() As Long
Dim i As Long, j As Long
Dim k As Long, l As Long
Dim cnt As Long, cnt1 As Long
Dim cell As Range, rng As Range
Dim cell1 As Range, sStr As String
Set rng = Range(Cells(1, 1), _
Cells(Rows.count, 1).End(xlUp))


Application.ScreenUpdating = False
For Each cell In rng
Application.StatusBar = cell.Address


Set cell1 = cell.Offset(0, 1)
If InStr(1, cell1.Value, "~", vbTextCompare) Then
Application.Goto cell, True
' cell.Interior.ColorIndex = 6
cnt = Len(cell1.Value)


ReDim v1(1 To cnt)
ReDim v2(1 To cnt)
ReDim v3(1 To cnt)
ReDim v4(1 To cnt)
ReDim v5(1 To cnt)
For i = 1 To cnt
v1(i) = cell1 _
.Characters(i, 1).Text
v2(i) = cell1 _
.Characters(i, 1).Font.Bold
v3(i) = cell1 _
.Characters(i, 1).Font.Name
v4(i) = cell1 _
.Characters(i, 1).Font.ColorIndex
v5(i) = cell1 _
.Characters(i, 1).Font.Italic


Next i


j = 0
For i = 1 To cnt
If v1(i) = "~" Then
cnt1 = cnt1 + Len(cell)
Else
cnt1 = cnt1 + 1
End If
Next i
ReDim v1a(1 To cnt1)
ReDim v2a(1 To cnt1)
ReDim v3a(1 To cnt1)
ReDim v4a(1 To cnt1)
ReDim v5a(1 To cnt1)
j = 1
For i = 1 To cnt
If v1(i) = "~" Then
For k = 1 To Len(cell)
v1a(j) = cell.Characters(k, 1).Text
v2a(j) = v2(i)
v3a(j) = v3(i)
v4a(j) = v4(i)
v5a(j) = v5(i)
j = j + 1
Next k
Else
v1a(j) = v1(i)
v2a(j) = v2(i)
v3a(j) = v3(i)
v4a(j) = v4(i)
v5a(j) = v5(i)
j = j + 1
End If
Next i
sStr = ""
For l = 1 To cnt1
sStr = sStr & v1a(l)
Next l
cell1.Value = sStr
For l = 1 To cnt1
cell1.Characters(l, 1).Font.Bold = v2a(l)
cell1.Characters(l, 1).Font.Name = v3a(l)
cell1.Characters(l, 1).Font.ColorIndex = v4a(l)
cell1.Characters(l, 1).Font.Italic = v5a(l)
Next l
Application.ScreenUpdating = True
Application.ScreenUpdating = False
End If
Next cell
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub

=================


Tom Ogilvy íàïèñà:
Sure, just follow the same pattern as for Bold.

--
Regards,
Tom Ogilvy


wrote in message
oups.com...
Hi Tom,

Your solution works (a bit slower but works!). It retains the bold and
red color font but the italic formatting was removed. Can this be
corrected?


Tom Ogilvy iaiena:
This is pretty slow, but does what you want. It shows what cell it is
working on in the status bar at the bottom left. The last processed cell
should be in the upper left corner of the screen.

Sub changeTilde()
Dim v1(), v2() As Boolean
Dim v1a(), v2a() As Boolean
Dim v3() As String, v3a() As String
Dim v4() As Long, v4a() As Long
Dim i As Long, j As Long
Dim k As Long, l As Long
Dim cnt As Long, cnt1 As Long
Dim cell As Range, rng As Range
Dim cell1 As Range, sStr As String
Set rng = Range(Cells(1, 1), _
Cells(Rows.Count, 1).End(xlUp))

Application.ScreenUpdating = False
For Each cell In rng
Application.StatusBar = cell.Address

Set cell1 = cell.Offset(0, 1)
If InStr(1, cell1.Value, "~", vbTextCompare) Then
Application.Goto cell, True
' cell.Interior.ColorIndex = 6
cnt = Len(cell1.Value)

ReDim v1(1 To cnt)
ReDim v2(1 To cnt)
ReDim v3(1 To cnt)
ReDim v4(1 To cnt)
For i = 1 To cnt
v1(i) = cell1 _
.Characters(i, 1).Text
v2(i) = cell1 _
.Characters(i, 1).Font.Bold
v3(i) = cell1 _
.Characters(i, 1).Font.Name
v4(i) = cell1 _
.Characters(i, 1).Font.ColorIndex

Next i

j = 0
For i = 1 To cnt
If v1(i) = "~" Then
cnt1 = cnt1 + Len(cell)
Else
cnt1 = cnt1 + 1
End If
Next i
ReDim v1a(1 To cnt1)
ReDim v2a(1 To cnt1)
ReDim v3a(1 To cnt1)
ReDim v4a(1 To cnt1)
j = 1
For i = 1 To cnt
If v1(i) = "~" Then
For k = 1 To Len(cell)
v1a(j) = cell.Characters(k, 1).Text
v2a(j) = v2(i)
v3a(j) = v3(i)
v4a(j) = v4(i)
j = j + 1
Next k
Else
v1a(j) = v1(i)
v2a(j) = v2(i)
v3a(j) = v3(i)
v4a(j) = v4(i)
j = j + 1
End If
Next i
sStr = ""
For l = 1 To cnt1
sStr = sStr & v1a(l)
Next l
cell1.Value = sStr
For l = 1 To cnt1
cell1.Characters(l, 1).Font.Bold = v2a(l)
cell1.Characters(l, 1).Font.Name = v3a(l)
cell1.Characters(l, 1).Font.ColorIndex = v4a(l)
Next l
Application.ScreenUpdating = True
Application.ScreenUpdating = False
End If
Next cell
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub

--
Regards,
Tom Ogilvy


" wrote:

Thank you all! That's what I need.

However your macro distorts all the formatting in colum B.

I tested both macros on this file:
http://rapidshare.com/files/9898670/Before.xls.html
and ended up with this:
http://rapidshare.com/files/9899030/After.xls.html

Can the macro be amended to preserve the original formatting?

Thanks again!