Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > VBA to superscript a part of a cell
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 5,600
Default VBA to superscript a part of a cell
Ah !
Gord - best bin my original...

FWIW, here's my original amended to cater for Rick's observations.

Sub SuperNum(rCell As Range)
Dim n As Long, pos As Long, start As Long
Dim s As String, sNum As String
Dim Target As Range
Dim vData, v, vFlag
Dim arr()

arr = Array("th", "1st", "2nd", "3rd")

Set Target = Selection
If rCell.HasFormula = False Then
vData = rCell.Value
If VarType(vData) = vbString Then
vFlag = rCell.Font.Superscript

If IsNull(vFlag) Then vFlag = True
If vFlag Then rCell.Font.Superscript = False
s = rCell.Value
If Len(s) 2 Then
For Each v In arr
pos = 0
start = 2
pos = -1
While pos
pos = InStr(start, s, v)
If pos Then
sNum = Mid$(s, pos - 1, 1)

n = Val(Mid$(s, pos - 1, 1))

If n Then
If pos + 1 < Len(s) Then
If Mid$(s, pos + 2, 1) < " " Then n = 0
End If
End If
If n 0 Then
rCell.Characters(pos, 2).Font.Superscript =
True

pos = 0
End If
start = pos + 1
End If
Wend
If n Then Exit For
Next
End If
End If
End If
End Sub


Regards,
Peter T


"Rick Rothstein" wrote in message
...
If the text in the cell has one of your ordinals with an actual word
before the day number having that ordinal, then nothing will be
superscripted. For example, if the text were one of these, then nothing
gets superscripted...

"Current start date is October 21st this year."

"August 1st begins the month."

"Hard start date: Jan 3rd."

--
Rick (MVP - Excel)



"Peter T" <peter_t@discussions wrote in message
...
Try this in a normal module

Option Explicit
Sub Test()
Dim rng As Range
Dim cel As Range

On Error Resume Next
Set rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants , 2)
On Error GoTo 0
If Not rng Is Nothing Then
For Each cel In rng
SuperNum cel
Next
End If
End Sub

Sub SuperNum(rCell As Range)
Dim n As Long, pos As Long
Dim s As String
Dim Target As Range
Dim vData, v, vFlag
Dim arr()

arr = Array("th", "st", "rd")
Set Target = Selection
If rCell.HasFormula = False Then
vData = rCell.Value
If VarType(vData) = vbString Then
vFlag = rCell.Font.Superscript

If IsNull(vFlag) Then vFlag = True
If vFlag Then rCell.Font.Superscript = False
s = rCell.Value
If Len(s) 2 Then
For Each v In arr
pos = 0
pos = InStr(2, s, v)
If pos Then
n = Val(Mid$(s, pos - 1, 1))
If n Then
If pos + 1 < Len(s) Then
If Mid$(s, pos + 2, 1) < " " Then n = 0
End If
End If
If n 0 Then
rCell.Characters(pos, 2).Font.Superscript =
True
Exit For
End If
End If
Next
End If
End If
End If
End Sub

Run Test() to process the active sheet

If you want changes to update immediately, try this in a worksheet module
(right - click sheet tab, view code)

Private Sub Worksheet_Change(ByVal Target As Range)
SuperNum Target(1)
End Sub

Regards,
Peter T




"Mikhail Bogorad" wrote in message
...
hi
i have a report that populates some text descriptions in cells range
B2:B15. So sometimes text has a date, for example "... October
1st...". What i want is to superscript letters "st" every time it
finds "1st".

Has anyone ever encountered this problem before?

Thanks




Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 1,565
Default VBA to superscript a part of a cell
I had seen some code by Tom Ogilvy dealing with Ordinal numbers but nothing
with Superscript or Subscript. It was just adding the two digit ordinal
onto the numbers. I'll tuck this away for future reference. Thanks Peter.



"Peter T" <peter_t@discussions wrote in message
...
Ah !
Gord - best bin my original...

FWIW, here's my original amended to cater for Rick's observations.

Sub SuperNum(rCell As Range)
Dim n As Long, pos As Long, start As Long
Dim s As String, sNum As String
Dim Target As Range
Dim vData, v, vFlag
Dim arr()

arr = Array("th", "1st", "2nd", "3rd")

Set Target = Selection
If rCell.HasFormula = False Then
vData = rCell.Value
If VarType(vData) = vbString Then
vFlag = rCell.Font.Superscript

If IsNull(vFlag) Then vFlag = True
If vFlag Then rCell.Font.Superscript = False
s = rCell.Value
If Len(s) 2 Then
For Each v In arr
pos = 0
start = 2
pos = -1
While pos
pos = InStr(start, s, v)
If pos Then
sNum = Mid$(s, pos - 1, 1)

n = Val(Mid$(s, pos - 1, 1))

If n Then
If pos + 1 < Len(s) Then
If Mid$(s, pos + 2, 1) < " " Then n =
0
End If
End If
If n 0 Then
rCell.Characters(pos, 2).Font.Superscript =
True

pos = 0
End If
start = pos + 1
End If
Wend
If n Then Exit For
Next
End If
End If
End If
End Sub


Regards,
Peter T


"Rick Rothstein" wrote in message
...
If the text in the cell has one of your ordinals with an actual word
before the day number having that ordinal, then nothing will be
superscripted. For example, if the text were one of these, then nothing
gets superscripted...

"Current start date is October 21st this year."

"August 1st begins the month."

"Hard start date: Jan 3rd."

--
Rick (MVP - Excel)



"Peter T" <peter_t@discussions wrote in message
...
Try this in a normal module

Option Explicit
Sub Test()
Dim rng As Range
Dim cel As Range

On Error Resume Next
Set rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants , 2)
On Error GoTo 0
If Not rng Is Nothing Then
For Each cel In rng
SuperNum cel
Next
End If
End Sub

Sub SuperNum(rCell As Range)
Dim n As Long, pos As Long
Dim s As String
Dim Target As Range
Dim vData, v, vFlag
Dim arr()

arr = Array("th", "st", "rd")
Set Target = Selection
If rCell.HasFormula = False Then
vData = rCell.Value
If VarType(vData) = vbString Then
vFlag = rCell.Font.Superscript

If IsNull(vFlag) Then vFlag = True
If vFlag Then rCell.Font.Superscript = False
s = rCell.Value
If Len(s) 2 Then
For Each v In arr
pos = 0
pos = InStr(2, s, v)
If pos Then
n = Val(Mid$(s, pos - 1, 1))
If n Then
If pos + 1 < Len(s) Then
If Mid$(s, pos + 2, 1) < " " Then n = 0
End If
End If
If n 0 Then
rCell.Characters(pos, 2).Font.Superscript =
True
Exit For
End If
End If
Next
End If
End If
End If
End Sub

Run Test() to process the active sheet

If you want changes to update immediately, try this in a worksheet
module (right - click sheet tab, view code)

Private Sub Worksheet_Change(ByVal Target As Range)
SuperNum Target(1)
End Sub

Regards,
Peter T




"Mikhail Bogorad" wrote in message
...
hi
i have a report that populates some text descriptions in cells range
B2:B15. So sometimes text has a date, for example "... October
1st...". What i want is to superscript letters "st" every time it
finds "1st".

Has anyone ever encountered this problem before?

Thanks






Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 5,600
Default VBA to superscript a part of a cell
JLGWhiz, afraid that wasn't quite right either! It didn't handle 11-13th
correctly, following also caters for multiple ordinals

test string
"August 1st, bend 2nd, third 3rd, 4th, 10th, 11th 101st 111th 4thousand"

Sub Test1()
Dim rng As Range
Dim cel As Range

On Error Resume Next
Set rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants , 2)
On Error GoTo 0
If Not rng Is Nothing Then
For Each cel In rng
SuperNum cel
Next
End If
End Sub

Sub test2()
SuperNum ActiveCell
End Sub

Sub SuperNum(rCell As Range)
Dim n As Long, pos As Long, start As Long
Dim s As String, sNum As String
Dim Target As Range
Dim vData, v, vFlag
Dim arr()

arr = Array("th", "st", "nd", "rd")

Set Target = Selection
If rCell.HasFormula = False Then
vData = rCell.Value
If VarType(vData) = vbString Then
vFlag = rCell.Font.Superscript

If IsNull(vFlag) Then vFlag = True
If vFlag Then rCell.Font.Superscript = False
s = rCell.Value
If Len(s) 2 Then
For Each v In arr
pos = 0
start = 2
pos = -1
While pos
pos = InStr(start, s, v)
If pos Then
sNum = Mid$(s, pos - 1, 1)

n = Val(sNum)
If n = 0 Then
If sNum = "0" Then n = -1
End If

If n Then
If pos + 1 < Len(s) Then
If Mid$(s, pos + 2, 1) _
Like "[ ,]" = False Then n = 0
End If
End If
If n Then
rCell.Characters(pos, 2).Font.Superscript =
True
End If
start = pos + 1
End If
Wend
Next
End If
End If
End If
End Sub

re Like "[ ,]"
include any other characters that might be allowed after an ordinal, such as
space or comma.

Looks like a lot of code but I think it should be the fastest approach here

Regards,
Peter T


"Peter T" <peter_t@discussions wrote in message
...
Ah !
Gord - best bin my original...

FWIW, here's my original amended to cater for Rick's observations.

Sub SuperNum(rCell As Range)
Dim n As Long, pos As Long, start As Long
Dim s As String, sNum As String
Dim Target As Range
Dim vData, v, vFlag
Dim arr()

arr = Array("th", "1st", "2nd", "3rd")

Set Target = Selection
If rCell.HasFormula = False Then
vData = rCell.Value
If VarType(vData) = vbString Then
vFlag = rCell.Font.Superscript

If IsNull(vFlag) Then vFlag = True
If vFlag Then rCell.Font.Superscript = False
s = rCell.Value
If Len(s) 2 Then
For Each v In arr
pos = 0
start = 2
pos = -1
While pos
pos = InStr(start, s, v)
If pos Then
sNum = Mid$(s, pos - 1, 1)

n = Val(Mid$(s, pos - 1, 1))

If n Then
If pos + 1 < Len(s) Then
If Mid$(s, pos + 2, 1) < " " Then n =
0
End If
End If
If n 0 Then
rCell.Characters(pos, 2).Font.Superscript =
True

pos = 0
End If
start = pos + 1
End If
Wend
If n Then Exit For
Next
End If
End If
End If
End Sub


Regards,
Peter T


"Rick Rothstein" wrote in message
...
If the text in the cell has one of your ordinals with an actual word
before the day number having that ordinal, then nothing will be
superscripted. For example, if the text were one of these, then nothing
gets superscripted...

"Current start date is October 21st this year."

"August 1st begins the month."

"Hard start date: Jan 3rd."

--
Rick (MVP - Excel)



"Peter T" <peter_t@discussions wrote in message
...
Try this in a normal module

Option Explicit
Sub Test()
Dim rng As Range
Dim cel As Range

On Error Resume Next
Set rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants , 2)
On Error GoTo 0
If Not rng Is Nothing Then
For Each cel In rng
SuperNum cel
Next
End If
End Sub

Sub SuperNum(rCell As Range)
Dim n As Long, pos As Long
Dim s As String
Dim Target As Range
Dim vData, v, vFlag
Dim arr()

arr = Array("th", "st", "rd")
Set Target = Selection
If rCell.HasFormula = False Then
vData = rCell.Value
If VarType(vData) = vbString Then
vFlag = rCell.Font.Superscript

If IsNull(vFlag) Then vFlag = True
If vFlag Then rCell.Font.Superscript = False
s = rCell.Value
If Len(s) 2 Then
For Each v In arr
pos = 0
pos = InStr(2, s, v)
If pos Then
n = Val(Mid$(s, pos - 1, 1))
If n Then
If pos + 1 < Len(s) Then
If Mid$(s, pos + 2, 1) < " " Then n = 0
End If
End If
If n 0 Then
rCell.Characters(pos, 2).Font.Superscript =
True
Exit For
End If
End If
Next
End If
End If
End If
End Sub

Run Test() to process the active sheet

If you want changes to update immediately, try this in a worksheet
module (right - click sheet tab, view code)

Private Sub Worksheet_Change(ByVal Target As Range)
SuperNum Target(1)
End Sub

Regards,
Peter T




"Mikhail Bogorad" wrote in message
...
hi
i have a report that populates some text descriptions in cells range
B2:B15. So sometimes text has a date, for example "... October
1st...". What i want is to superscript letters "st" every time it
finds "1st".

Has anyone ever encountered this problem before?

Thanks






Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 5,651
Default VBA to superscript a part of a cell
On Fri, 16 Apr 2010 10:08:05 +0100, "Peter T" <peter_t@discussions wrote:

JLGWhiz, afraid that wasn't quite right either! It didn't handle 11-13th
correctly, following also caters for multiple ordinals

test string
"August 1st, bend 2nd, third 3rd, 4th, 10th, 11th 101st 111th 4thousand"

Sub Test1()
Dim rng As Range
Dim cel As Range

On Error Resume Next
Set rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants , 2)
On Error GoTo 0
If Not rng Is Nothing Then
For Each cel In rng
SuperNum cel
Next
End If
End Sub

Sub test2()
SuperNum ActiveCell
End Sub

Sub SuperNum(rCell As Range)
Dim n As Long, pos As Long, start As Long
Dim s As String, sNum As String
Dim Target As Range
Dim vData, v, vFlag
Dim arr()

arr = Array("th", "st", "nd", "rd")

Set Target = Selection
If rCell.HasFormula = False Then
vData = rCell.Value
If VarType(vData) = vbString Then
vFlag = rCell.Font.Superscript

If IsNull(vFlag) Then vFlag = True
If vFlag Then rCell.Font.Superscript = False
s = rCell.Value
If Len(s) 2 Then
For Each v In arr
pos = 0
start = 2
pos = -1
While pos
pos = InStr(start, s, v)
If pos Then
sNum = Mid$(s, pos - 1, 1)

n = Val(sNum)
If n = 0 Then
If sNum = "0" Then n = -1
End If

If n Then
If pos + 1 < Len(s) Then
If Mid$(s, pos + 2, 1) _
Like "[ ,]" = False Then n = 0
End If
End If
If n Then
rCell.Characters(pos, 2).Font.Superscript =
True
End If
start = pos + 1
End If
Wend
Next
End If
End If
End If
End Sub

re Like "[ ,]"
include any other characters that might be allowed after an ordinal, such as
space or comma.

Looks like a lot of code but I think it should be the fastest approach here

Regards,
Peter T

This will superscript the ordinal even if it is not the correct one for the
value.

It also fails to recognize some legitimate constructs

E.g. Test strings

"101th vs 101st"
"May 21st-Jun 16th"




--ron
Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 5,600
Default VBA to superscript a part of a cell

"Ron Rosenfeld" wrote in message
...
On Fri, 16 Apr 2010 10:08:05 +0100, "Peter T" <peter_t@discussions wrote:

JLGWhiz, afraid that wasn't quite right either! It didn't handle 11-13th
correctly, following also caters for multiple ordinals

test string
"August 1st, bend 2nd, third 3rd, 4th, 10th, 11th 101st 111th 4thousand"

Sub Test1()
Dim rng As Range
Dim cel As Range

On Error Resume Next
Set rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants , 2)
On Error GoTo 0
If Not rng Is Nothing Then
For Each cel In rng
SuperNum cel
Next
End If
End Sub

Sub test2()
SuperNum ActiveCell
End Sub

Sub SuperNum(rCell As Range)
Dim n As Long, pos As Long, start As Long
Dim s As String, sNum As String
Dim Target As Range
Dim vData, v, vFlag
Dim arr()

arr = Array("th", "st", "nd", "rd")

Set Target = Selection
If rCell.HasFormula = False Then
vData = rCell.Value
If VarType(vData) = vbString Then
vFlag = rCell.Font.Superscript

If IsNull(vFlag) Then vFlag = True
If vFlag Then rCell.Font.Superscript = False
s = rCell.Value
If Len(s) 2 Then
For Each v In arr
pos = 0
start = 2
pos = -1
While pos
pos = InStr(start, s, v)
If pos Then
sNum = Mid$(s, pos - 1, 1)

n = Val(sNum)
If n = 0 Then
If sNum = "0" Then n = -1
End If

If n Then
If pos + 1 < Len(s) Then
If Mid$(s, pos + 2, 1) _
Like "[ ,]" = False Then n = 0
End If
End If
If n Then
rCell.Characters(pos, 2).Font.Superscript
=
True
End If
start = pos + 1
End If
Wend
Next
End If
End If
End If
End Sub

re Like "[ ,]"
include any other characters that might be allowed after an ordinal, such
as
space or comma.

Looks like a lot of code but I think it should be the fastest approach
here

Regards,
Peter T

This will superscript the ordinal even if it is not the correct one for
the
value.

I had thought of that and could be adapted (the previous version did) but
thought probably not worth bothering with

It also fails to recognize some legitimate constructs

E.g. Test strings

"101th vs 101st"
"May 21st-Jun 16th"

To cater for that particular one, ie the dash, amend the Like string as I
had suggested previously -

Like "[ ,-]" = False Then n = 0

Now let me pop over to yours and make a suggestion :-)

Regards,
Peter Thornton


Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Search/Match/Find ANY part of string to ANY part of Cell Value TWhizTom Excel Worksheet Functions 0 July 21st 08 08:16 PM
superscript in part of a string when using concatenate Ged2 Excel Discussion (Misc queries) 1 August 23rd 05 02:47 PM
how do i superscript part of a cell in MS Excel? allan Excel Discussion (Misc queries) 8 July 20th 05 10:37 PM
how do i superscript part of a cell in MS Excel? allan Excel Discussion (Misc queries) 0 July 13th 05 08:12 PM


All times are GMT +1. The time now is 08:26 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement