edit vba code for display In Exponential Form

[abbccc]

i find a v.b.a code for decomposition into prime
but the result is same string
i want display In Exponential Form
please edit v.b.a code


v.b.a code is

[VBA]
Sub Prime()
Dim n As Long, i As Long, s As String
n = ActiveCell
i = 2
Do While n >= i
If n Mod i = 0 Then
s = s & " * " & CStr(i)
n = n \ i
Else
i = i + 1
End If
Loop
ActiveCell.Offset(0, 1).Value = Mid(s, 4)
End Sub
[/VBA]
for example

display.jpg

[abbccc]

help

[abbccc]

help help help

[abbccc]

please edit vba code or give me a other vba code

[p45cal]

duplicate of http://vbaexpress.com/forum/showthread.php?t=46060 and cross-posted http://www.xtremevbtalk.com/showthread.php?t=325884.

Try:[VBA]Sub Prime3()
Dim n, i As Long, s As String, Res()
ReDim Res(0 To 0), ExpoLen(0 To 0), ExpoPosn(0 To 0)
n = ActiveCell
i = 2
Do While n >= i
If n Mod i = 0 Then
ReDim Preserve Res(0 To UBound(Res) + 1)
Res(UBound(Res)) = i
n = n \ i
Else
i = i + 1
End If
Loop
myexponent = 1
For i = 1 To UBound(Res)
If i < UBound(Res) Then
If Res(i) = Res(i + 1) Then
myexponent = myexponent + 1
Else
'Stop
If myexponent > 1 Then
ReDim Preserve ExpoPosn(0 To UBound(ExpoPosn) + 1)
ReDim Preserve ExpoLen(0 To UBound(ExpoLen) + 1)
mystring = mystring & "*" & Res(i)
If Left(mystring, 1) = "*" Then mystring = Mid(mystring, 2)
ExpoPosn(UBound(ExpoPosn)) = Len(mystring) + 1
ExpoLen(UBound(ExpoLen)) = Len(myexponent)
mystring = mystring & myexponent
myexponent = 1
Else
mystring = mystring & "*" & Res(i)
End If
End If
Else
'last or only value
If myexponent > 1 Then
ReDim Preserve ExpoPosn(0 To UBound(ExpoPosn) + 1)
ReDim Preserve ExpoLen(0 To UBound(ExpoLen) + 1)
mystring = mystring & "*" & Res(i)
If Left(mystring, 1) = "*" Then mystring = Mid(mystring, 2)
ExpoPosn(UBound(ExpoPosn)) = Len(mystring) + 1
ExpoLen(UBound(ExpoLen)) = Len(myexponent)
mystring = mystring & myexponent
Else
mystring = mystring & "*" & Res(i)
If Left(mystring, 1) = "*" Then mystring = Mid(mystring, 2)
End If
End If
Next i
ActiveCell.Offset(, 2) = mystring
For i = 1 To UBound(ExpoLen)
ActiveCell.Offset(, 2).Characters(Start:=ExpoPosn(i), Length:=ExpoLen(i)).Font.Superscript = True
Next i
End Sub
[/VBA]This is not perfect, there is a least one bug - working on it.

[p45cal]

Bug fixed:[VBA]Sub Prime3()
Dim n, i As Long, s As String, Res()
ReDim Res(0 To 0), ExpoLen(0 To 0), ExpoPosn(0 To 0)
n = ActiveCell
i = 2
Do While n >= i
If n Mod i = 0 Then
ReDim Preserve Res(0 To UBound(Res) + 1)
Res(UBound(Res)) = i
n = n \ i
Else
i = i + 1
End If
Loop
myexponent = 1
For i = 1 To UBound(Res)
If i < UBound(Res) Then
If Res(i) = Res(i + 1) Then
myexponent = myexponent + 1
Else
'Stop
If myexponent > 1 Then
ReDim Preserve ExpoPosn(0 To UBound(ExpoPosn) + 1)
ReDim Preserve ExpoLen(0 To UBound(ExpoLen) + 1)
mystring = mystring & "*" & Res(i)
If Left(mystring, 1) = "*" Then mystring = Mid(mystring, 2)
ExpoPosn(UBound(ExpoPosn)) = Len(mystring) + 1
ExpoLen(UBound(ExpoLen)) = Len(myexponent)
mystring = mystring & myexponent
myexponent = 1
Else
mystring = mystring & "*" & Res(i)
End If
End If
Else
'last or only value
If myexponent > 1 Then
ReDim Preserve ExpoPosn(0 To UBound(ExpoPosn) + 1)
ReDim Preserve ExpoLen(0 To UBound(ExpoLen) + 1)
mystring = mystring & "*" & Res(i)
If Left(mystring, 1) = "*" Then mystring = Mid(mystring, 2)
ExpoPosn(UBound(ExpoPosn)) = Len(mystring) + 1
ExpoLen(UBound(ExpoLen)) = Len(myexponent)
mystring = mystring & myexponent
Else
mystring = mystring & "*" & Res(i)
If Left(mystring, 1) = "*" Then mystring = Mid(mystring, 2)
End If
End If
Next i
With ActiveCell.Offset(, 2)
.NumberFormat = "@"
.Value = mystring
For i = 1 To UBound(ExpoLen)
.Characters(Start:=ExpoPosn(i), Length:=ExpoLen(i)).Font.Superscript = True
Next i
End With
End Sub
[/VBA]

[abbccc]

Thank you very much Thank you very much Thank you very much Thank you very much Thank you very much


You're the best teacher I
You're the best teacher I
You're the best teacher I

[abbccc]

p45cal :
You're the best teacher I

You're the best teacher I
You're the best teacher I

[abbccc]

Is this code works for any number

[abbccc]

help
Is this code works for any number

[abbccc]

help

[p45cal]

Is this code works for any number

Up to 2,147,483,647
It may take a few minutes if the number is large and prime.

[abbccc]

Thank you
p45cal :
You're the best teacher I