Excel macro for superscripts? - vba

Question

I have the following data in Excel:
1.07 ± 0.35^a 1.21 ± 0.13^a 0.67 ± 0.31^a 1.43 ± 0.05^a
I am looking for a macro to change the text after the ^ symbol to superscript, whilst also removing the ^ symbol. I thought I had found the answer from this site http://www.beingbrunel.com/inline-subsuper-script-in-excel-and-more/, but I can't get the add-in to work.
This is my attempted code, but no cigar.
Sub Loop_Exampl()
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
'We use the ActiveSheet but you can replace this with
'Sheets("MySheet")if you want
With ActiveSheet
'We select the sheet so we can change the window view
.Select
'If you are in Page Break Preview Or Page Layout view go
'back to normal view, we do this for speed
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
'Turn off Page Breaks, we do this for speed
.DisplayPageBreaks = False
'Set the first and last row to loop through
Firstrow = .UsedRange.Cells(1).Row
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
'We loop from Lastrow to Firstrow (bottom to top)
For Lrow = Lastrow To Firstrow Step -1
'We check the values in the A column in this example
With .Cells(Lrow, "B")
With ActiveCell.Characters(Start:=2, Length:=1).Font
.Superscript = False
.Subscript = True
End With
End Sub

Answer 1

Not sure how you'd do this without the ^ Maybe superscript every letter which directly c=follows a digit ?
Sub tester()
Dim c As Range
For Each c In Selection.Cells
SuperIt c
Next c
End Sub
Sub SuperIt(rng As Range)
Dim s, p, e
s = rng.Text
p = InStr(s, "^")
If p > 0 Then
Do
e = 1
Do While Mid(s, p + e, 1) <> " " And p + e < Len(s)
e = e + 1
Loop
rng.Characters(p, 1).Delete
rng.Characters(p, e).Font.Superscript = True
s = rng.Text
p = InStr(s, "^")
Loop While p > 0
End If
End Sub

Answer 2

This code will create superscripts of letters in the selected range, meaning that the ^ symbol is not required.
Sub FixFormatting()
Dim c As Range
Dim StartCells As Range
Dim ws As Worksheet
Dim intPlace As Integer
Dim wsStartsProtected As Boolean
Application.ScreenUpdating = False
On Error GoTo errorCatch
Set StartCells = Selection
For Each c In Selection.Cells
With c
.Replace What:="a", Replacement:="a", LookAt:=xlPart, MatchCase:=False
.Replace What:="b", Replacement:="b", LookAt:=xlPart, MatchCase:=False
.Replace What:="c", Replacement:="c", LookAt:=xlPart, MatchCase:=False
End With
intPlace = InStr(c.Value, "a")
If intPlace > 0 Then
If ActiveSheet.ProtectContents = True Then ActiveSheet.Unprotect
c.Characters(intPlace, 1).Font.Superscript = True
End If
intPlace = InStr(c.Value, "b")
If intPlace > 0 Then
If ActiveSheet.ProtectContents = True Then ActiveSheet.Unprotect
c.Characters(intPlace, 1).Font.Superscript = True
End If
intPlace = InStr(c.Value, "c")
If intPlace > 0 Then
If ActiveSheet.ProtectContents = True Then ActiveSheet.Unprotect
c.Characters(intPlace, 1).Font.Superscript = True
End If
If wsStartsProtected Then ws.Protect
Next
StartCells.Parent.Activate
StartCells.Select
Application.ScreenUpdating = True
Exit Sub
errorCatch:
If wsStartsProtected Then ws.Protect
StartCells.Parent.Activate
StartCells.Select
Application.ScreenUpdating = True
End Sub