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/show...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/show...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 :

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 :

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]

[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