PC Review


Reply
Thread Tools Rate Thread

VBA to superscript a part of a cell

 
 
Mikhail Bogorad
Guest
Posts: n/a
 
      15th Apr 2010
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 Quote
 
 
 
 
JLGWhiz
Guest
Posts: n/a
 
      15th Apr 2010
This is a sample of the syntax to accomplish the goal. Without knowing how
the data appears within your file, I cannot offer any more than this.

Range("B3").Characters(7, 2).Font.Superscript = True

This would re-format the seventh and eighth characters in the cell to
superscript. I am not sure how to find the occurrences in the file by
random search. Maybe somebody smarter than me will assist.



"Mikhail Bogorad" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> 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 Quote
 
 
 
 
Peter T
Guest
Posts: n/a
 
      15th Apr 2010
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" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> 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 Quote
 
Rick Rothstein
Guest
Posts: n/a
 
      15th Apr 2010
If I can anticipate your complete requirements (for 1st, 2nd, 3rd, nth),
give this macro a try after the cells have been filled in with their text...

Sub SuperScriptOrdinals()
Dim X As Long, NumPosition As Long, Cell As Range
For Each Cell In Range("B2:B15")
NumPosition = InStr(Cell.Value, "1st")
If NumPosition = 0 Then
NumPosition = InStr(Cell.Value, "2nd")
If NumPosition = 0 Then
NumPosition = InStr(Cell.Value, "3rd")
If NumPosition = 0 Then
For NumPosition = 1 To Len(Cell.Text)
If Mid(Cell.Value, NumPosition) Like "#th*" Then Exit For
Next
End If
End If
End If
If NumPosition Then
Cell.Characters(NumPosition + 1, 2).Font.Superscript = True
End If
Next
End Sub

--
Rick (MVP - Excel)



"Mikhail Bogorad" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> 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 Quote
 
Gord Dibben
Guest
Posts: n/a
 
      15th Apr 2010
Very nice Peter.

I have saved this one.

You could add "nd" to the array.


Gord

On Thu, 15 Apr 2010 19:43:14 +0100, "Peter T" <peter_t@discussions> wrote:

>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" <(E-Mail Removed)> wrote in message
>news:(E-Mail Removed)...
>> 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 Quote
 
Rick Rothstein
Guest
Posts: n/a
 
      15th Apr 2010
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
news:(E-Mail Removed)...
> 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" <(E-Mail Removed)> wrote in message
> news:(E-Mail Removed)...
>> 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 Quote
 
Peter T
Guest
Posts: n/a
 
      15th Apr 2010
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" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> 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
> news:(E-Mail Removed)...
>> 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" <(E-Mail Removed)> wrote in message
>> news:(E-Mail Removed)...
>>> 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 Quote
 
Gord Dibben
Guest
Posts: n/a
 
      15th Apr 2010
Your testing was more thorough than mine Rick

I see what you mean after more testing.



Gord

On Thu, 15 Apr 2010 15:43:28 -0400, "Rick Rothstein"
<(E-Mail Removed)> wrote:

>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."


 
Reply With Quote
 
Ron Rosenfeld
Guest
Posts: n/a
 
      16th Apr 2010
On Thu, 15 Apr 2010 14:49:14 -0400, "Rick Rothstein"
<(E-Mail Removed)> wrote:

>If I can anticipate your complete requirements (for 1st, 2nd, 3rd, nth),
>give this macro a try after the cells have been filled in with their text...
>
>Sub SuperScriptOrdinals()
> Dim X As Long, NumPosition As Long, Cell As Range
> For Each Cell In Range("B2:B15")
> NumPosition = InStr(Cell.Value, "1st")
> If NumPosition = 0 Then
> NumPosition = InStr(Cell.Value, "2nd")
> If NumPosition = 0 Then
> NumPosition = InStr(Cell.Value, "3rd")
> If NumPosition = 0 Then
> For NumPosition = 1 To Len(Cell.Text)
> If Mid(Cell.Value, NumPosition) Like "#th*" Then Exit For
> Next
> End If
> End If
> End If
> If NumPosition Then
> Cell.Characters(NumPosition + 1, 2).Font.Superscript = True
> End If
> Next
>End Sub
>
>--
>Rick (MVP - Excel)


As you write, you are trying to anticipate the complete requirements.

But I note that your routine does not completely error check for incorrect
suffixes. For example, May 21th would have the "th" superscripted.



--ron
 
Reply With Quote
 
Ron Rosenfeld
Guest
Posts: n/a
 
      16th Apr 2010
On Thu, 15 Apr 2010 10:24:05 -0700 (PDT), Mikhail Bogorad
<(E-Mail Removed)> wrote:

>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


There are some issues you haven't mentioned.

1. Are the cell contents strings, or are they the results of formulas. If
they are the results of formulas, then they must be converted to strings in
order to superscript a few letters.

2. Could there be more than one substring that requires superscripting. For
example, May 21st through May 28th ?

3. How do you want to handle a number followed by two letters that do not
represent a valid ordinal suffix? For example: 101th day of the year.

Here is a routine that
If the contents of the cell "qualify" by containing an ordinal number,
then the contents will be converted to a text string in order to apply the
ordinal superscripting.
If the ordinal value is not valid, nothing will be done.
It can handle any number of ordinal values within the string.

===========================================================
Option Explicit
Sub SupScriptOrdinal()
Dim re As Object, mc As Object, m As Object
Dim Suffix As String
Dim N As Long
Dim SuffixStart As Long
Dim c As Range

For Each c In Range("B2:B15")

Set re = CreateObject("vbscript.regexp")
re.Pattern = "\b(\d+)(\w{2})\b"
re.Global = True

If re.test(c) = True Then
Set mc = re.Execute(c)
For Each m In mc
N = m.SubMatches(0)
Select Case N Mod 10
Case Is = 1
Suffix = "st"
Case Is = 2
Suffix = "nd"
Case Is = 3
Suffix = "rd"
Case Else
Suffix = "th"
End Select

Select Case N Mod 100
Case 11 To 19
Suffix = "th"
End Select

If Suffix = LCase(m.SubMatches(1)) Then
'comment next line if you do not want to convert
' qualifying contents to text strings
c.Value = c.Text
SuffixStart = m.FirstIndex + 1 + Len(CStr(N))
c.Characters(SuffixStart, 2).Font.Superscript = True
End If

Next m
End If
Next c
End Sub
===================================
--ron
 
Reply With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

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


Similar Threads
Thread Thread Starter Forum Replies Last Post
superscript of report ex( Mey 12 2008) 12 in superscript help Microsoft Access Reports 1 12th Mar 2008 10:56 AM
superscript in part of a string when using concatenate Ged2 Microsoft Excel Misc 1 23rd Aug 2005 02:47 PM
determine if part of text is sub or superscript =?Utf-8?B?Qm93bEJvYXJkZXI=?= Microsoft Dot NET Framework Forms 0 6th Aug 2005 06:15 PM
how do i superscript part of a cell in MS Excel? =?Utf-8?B?YWxsYW4=?= Microsoft Excel Misc 8 20th Jul 2005 10:37 PM
how do i superscript part of a cell in MS Excel? =?Utf-8?B?YWxsYW4=?= Microsoft Excel Misc 0 13th Jul 2005 08:12 PM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 02:48 AM.