Extract superscript and paste it into new column same row - excel

Question

I have been searching for a while now a code to help me to extract superscript characters (number 1 and 2) that are either in the middle or at the end of a string in column A. I need to cut them from the string and paste them into the same row, but on column C as a normal number.
I did not find any suitable solutions I could evev try. So I do not have any code because I do not know where to start. My data will have always less than 500 lines and has the same structure, but lines with superscript change.
Does anyone know to solve this problem please? Thanks a lot.
I would really appreciate the help.
Desired output: for every row where there is a superscript, cut it from string in Column A and paste it in column C as a normal number..

Answer 1

Sub extractSuperscript()
Dim rng As Range
Dim cell As Range
Dim i As Long
Dim j As Long
Dim result As String
' Define the range to process
Set rng = Range("A1:A10")
' Loop through each cell in the range
For i = 1 To rng.Cells.Count
Set cell = rng.Cells(i)
result = ""
' Loop through each character in the cell
For j = 1 To Len(cell.Value)
' Check if the character is a superscript 1 or 2
If Mid(cell.Value, j, 1) = "¹" Or Mid(cell.Value, j, 1) = "²" Then
' If the character is a superscript 1, add a 1 to the result string
If Mid(cell.Value, j, 1) = "¹" Then
result = result & "1"
' If the character is a superscript 2, add a 2 to the result string
ElseIf Mid(cell.Value, j, 1) = "²" Then
result = result & "2"
End If
End If
Next j
' Paste the result string into column C and remove the superscript from column A
cell.Offset(0, 2).Value = result
cell.Value = Replace(cell.Value, "¹", "")
cell.Value = Replace(cell.Value, "²", "")
Next i
End Sub
Let me know if this works

Answer 2

Let me know if the following works:
Option Explicit
Sub Superscript()
Application.ScreenUpdating = True
Dim wb As Workbook
Dim ws As Worksheet
Dim rngSuperscript As Range, c As Range
Dim iCount As Integer
Dim MyString As String
Set wb = ThisWorkbook
'Set it to sheet name where your data is
Set ws = wb.Sheets("Test")
'Change it to reflect your data
Set rngSuperscript = ws.Range("A2:A11")
For Each c In rngSuperscript
'temp text variable
MyString = c.Value
'loop through the string value
For iCount = 1 To Len(MyString)
'check if it is numeric
If IsNumeric(Mid(MyString, iCount, 1)) Then
'combine with the C column value (if any)
c.Offset(0, 2).Value = CLng(c.Offset(0, 2).Value & Mid(MyString, iCount, 1))
End If
Next
Next c
Application.ScreenUpdating = False
End Sub