VBA how to superscript characters in a string following an apostrophe?

[johnnyfever]

Let's say I have a string that contains this sentence:


Jn'o Martin met Alex'dr Jones at Harry's house with Ja's Stuart.

The apostrophes used in the proper names, John, Alexander and James are indicators that the next letter or two should be superscript characters. The apostrophe in Harry's is indicating the possessive case and is used properly in that the apostrophe is simply an apostrophe and not an indicator that the s following it should be superscript.

Can someone tell me the VBA code (not an excel formula) to search the string and change the letters following an apostrophe to superscript with the following conditions:

1) Only in the situation of Ja's is an apostrophe followed by an s not considered a possessive case, otherwise ignore any situations in which 's is found.
2) For all other cases where an apostrophe is found in the string then delete that apostrophe and convert into superscript any letters found after that apostrophe until a space or period is encountered.

I'm embarrassed to say that I don't even have a clue how to tackle this since doing anything with regular expressions always makes my head spin so I can't offer any code that I've already tried.

[paulked]

Even before attempting to convert the letters to superscript (Use ChrW() for the Unicode values of the letters), what is your formula or rule for finding the words that have a possessive case?

Take a look here http://www.vbaexpress.com/forum/showthread.php?60539-Find-amp-replace-possessive-s-(eg-Adam-s)-using-macro, it may help.

[johnnyfever]

Even before attempting to convert the letters to superscript (Use ChrW() for the Unicode values of the letters), what is your formula or rule for finding the words that have a possessive case?

Take a look here http://www.vbaexpress.com/forum/showthread.php?60539-Find-amp-replace-possessive-s-(eg-Adam-s)-using-macro, it may help.

Sorry, but I really have no idea. If I left that part of the requirement out I would just search them manually in the spreadsheet. There won't be that many.

[paulked]

Okay, so based on a maximum of two lower case characters after the apostrophe:



Sub SuperScriptIt()
Dim aUni, a, sIn$, sOut$, i&, j&, s1&, s2&
aUni = Split("1D43,1D47,1D9C,1D48,1D49,1DA0,1D4D,02B0,2071,02B2,1D4F,02E1,1D50,207F,1D52, 1D56,,02B3,02E2,1D57,1D58,1D5B,02B7,02E3,02B8,1DBB", ",")
sIn = Cells(1, 1) 'Input String
a = Split(sIn)
For i = LBound(a) To UBound(a)
For j = 1 To Len(a(i))
If Mid(a(i), j, 1) = "'" Then
s1 = Asc(Mid(a(i), j + 1, 1))
sOut = sOut & "'" & ChrW("&H" & aUni(s1 - 97))
On Error Resume Next
s2 = Asc(Mid(a(i), j + 2, 1))
sOut = sOut & ChrW("&H" & aUni(s2 - 97))
On Error GoTo 0
Exit For
Else
sOut = sOut & Mid(a(i), j, 1)
End If
Next
sOut = sOut & " "
s1 = 0
s2 = 0
Next
Cells(2, 1) = Left(sOut, Len(sOut) - 1) 'Output string
End Sub


Be aware, there is no unicode for a superscript 'q' so avoid them!

[Paul_Hossler]

Another way



Option Explicit


'Jn'o Martin met Alex'dr Jones at Harry's house with Ja's Stuart.


Sub drv()

Call SupScr(ActiveSheet.Range("A1"))


End Sub




Sub SupScr(r As Range)
Dim i As Long, j As Long

For i = 1 To Len(r.Value)
If Mid(r.Value, i, 1) <> "'" Then GoTo NextLetter

If i > 3 Then If Mid(r.Value, i - 2, 2) = "Ja" Then GoTo NextLetter

j = i + 1

If j > Len(r.Value) Then GoTo NextLetter

Do
r.Characters(Start:=j, Length:=1).Font.Superscript = True
j = j + 1
Loop Until j > Len(r.Value) Or Mid(r.Value, j, 1) = " " Or Mid(r.Value, j, 1) = "."

NextLetter:
Next i
End Sub

[johnnyfever]

Another way



Option Explicit







Thanks to both of you guys for responding. I don't think I made something clear. This string is not stored in a cell and it looks like both of the solutions that were posted take a value from a cell and do the manipulation. I can post my spreadsheet if needed, but this string is created from the contents of multiple cells. Here's a brief example of some of the code where the string is created:



For j = startrow To endrow
DeedBook = .Cells(j, "A").Value
PageNo = .Cells(j, "B").Value
DeedNo = .Cells(j, "C").Value
DateOfDeed = .Cells(j, "D").Value

......

If Len(.Cells(j, "U").Value) > 0 Then

strLineOfText = DeedBook & ", " & PageNo

If Len(.Cells(j, "C").Value) > 0 Then
If Left(.Cells(j, "C").Value, 1) = "[" Then
strLineOfText = strLineOfText & ", " & DeedNo
Else
strLineOfText = strLineOfText & ", #" & DeedNo
End If
End If

wordApp.Selection.Font.Bold = True
wordApp.Selection.TypeText strLineOfText
wordApp.Selection.Font.Bold = False

strLineOfText = ", " & Freeform

If Right(strLineOfText, 1) <> "." Then
strLineOfText = strLineOfText & "."
End If

wordApp.Selection.TypeText strLineOfText

Else
......


The string is strLineOfText. My spreadsheet has columns A through AA and depending on what is stored in which column strLineOfText is created by adding the contents of one cell to the next (although it's a little more complicated than that. So strLineOfText is built up cell by cell depending what each cell contains. By the time it's completed an entire paragraph is created. Here is an example of a created paragraph:

-------------------------
G, 4-5, #4, 22 Oct 1798, Jeremiah Kingsley of Chester County to Patrick McGriff of same for £60, 150a situate on waters of Fishing Creek, originally granted to John Owen 26 Aug 1774 and conveyed by John Owen to Jeremiah Kingsley. /s/ Jeremiah Kingsley. Wit: John McGriff, Wm McGriff. Proven by oath of John McGriff before Sam'l Lacey, clerk, 30 Mar 1799. Recorded 5 Apr 1799.
-------------------------

Virtually everything in that paragraph is stored in a cell in some way or another.

What I'm doing is creating a book of transcribed old deed book records. It is far easier for me to use a custom user form to enter the data for each deed and then once I enter all the data for my book I run a macro that creates the entry for each deed and outputs it to Word.

Looking back I shouldn't have been putting those apostrophes in and just said the hell with it and left Jas as Jas (old style shorthand for James) instead of putting in the apostrophes to superscript the letters they would write in shorthand.

[Paul_Hossler]

Thanks to both of you guys for responding. I don't think I made something clear. This string is not stored in a cell and it looks like both of the solutions that were posted take a value from a cell and do the manipulation. I can post my spreadsheet if needed, but this string is created from the contents of multiple cells. Here's a brief example of some of the code where the string is created:

So

strLineOfText = A1 + B1 + C1 + ...
strLineOfText = A2 + B2 + C2 + ...

etc.

for a bunch of rows

So you could put strLineOfText in a cell and run the macro on that cell if you want the superscripts

I don't know it the superscripts formatting will transfer to Word

You might end up with a Word macro instead

[johnnyfever]

I don't know it the superscripts formatting will transfer to Word

You might end up with a Word macro instead

That's a good point. Excel VBA wouldn't transfer bold characters to Word so I had to do the


wordApp.Selection.Font.Bold = True
wordApp.Selection.TypeText strLineOfText
wordApp.Selection.Font.Bold = False

bit to get just the characters in bold that I specifically wanted to transfer to Word.

I'm sure there's a way to do it, but it sounds way more complicated than I want to get into.

[SamT]

It is far easier for me to use a custom user form to enter the data for each deed
Make up your own superscript switch instead of an apostrophe. It merely has to something you will never see in any normal text in your book. Example "/s" before any letter that Word should super. Maybe /b for bold character. Word might already have such a mechanism :dunno:

In any case, you can run the string thru your own parser before it gets to Word



It sounds to me like your book is either a work of love... Or a work for money. Either way. it would pay you to learn to use LaTex, which is designed for this. A book is a long term project, especially when you're transcribing 200+ yo land deeds.

[johnnyfever]

Make up your own superscript switch instead of an apostrophe. It merely has to something you will never see in any normal text in your book. Example "/s" before any letter that Word should super. Maybe /b for bold character. Word might already have such a mechanism :dunno:

In any case, you can run the string thru your own parser before it gets to Word



It sounds to me like your book is either a work of love... Or a work for money. Either way. it would pay you to learn to use LaTex, which is designed for this. A book is a long term project, especially when you're transcribing 200+ yo land deeds.

That's a great idea. I'll look into that when I get to the end of this. I'm definitely NOT doing this for the money! I only expect to sell 200-250 copies and another author is going to help publish so he'll probably get a cut. This is a project I would have under taken on my own for my personal use since I like plotting old deeds and since I was already writing articles for a journal the author I mentioned publishes I thought I might as well publish these deeds.

I haven't used LaTeX in more years than I want to admit (in college) although I've used Scribus for a couple of other projects. I tried using MS Publisher since it has some handy tools for publishing, but it isn't exactly intuitive to me.

[SamT]

:thumb

[Paul_Hossler]

Original post only asked about superscript

Follow on idea / suggestion / concept

1. Excel macro to join the cells to make a single string

2. Use common 'standard' tags to mark the text in the string requiring special processing: <b> text </b> for bold, <i> text </i> for italic, <sub> text </sup> for superscript, <sub> ....... you get the idea

3. Export to MS Word

4. Pretty simple MS Word macro to F&R "<b>The quick brown dog</b>" with "The quick brown dog"

etc.

[snb]

Sub M_snb()
Cells(4, 1) = "Jn'o Martin met Alex'dr Jones at Harry's house with Ja's Stuart."
Cells(4, 1).Replace "'s", "`s", 2
c00 = Cells(4, 1)

For j = 1 To Len(c00)
If Asc(Mid(c00, j, 1)) = 39 Then
For jj = j To Len(c00)
If InStr(" .,?!;", Mid(c00, jj, 1)) Then Exit For
Next
Cells(4, 1).Characters(j + 1, jj - j).Font.Superscript = True
End If
Next
End Sub