Array splitting and extracting - arrays

Question

I'm attempting to go through each character in a cell to determine whether or not a word is underlined and italicized but so far the loop runs and freezes. How can I copy and move the word that is italicized and underlined? This is what I have so far. I asked a new question because I wasn't clear enough in this one. It can be accessed at Array split and extract vba excel .
For Each j In ActiveSheet.Range("C1:C105")
v = Trim(j.Value)
If Len(v) > 0 Then
v = Replace(v, vbLf, " ")
Do While InStr(v, " ") > 0
v = Replace(v, " ", " ")
Loop
arr = Split(v, " ")
For Z = LBound(arr) To UBound(arr)
e = arr(Z)
For i = 1 To Len(v)
If j.Characters(i, 1).Font.Italic = True And j.Characters(i, 1).Font.Underline = True Then
j.Value.Copy
End If
Next i
Next Z
End If
Next j​

Answer 1

The following piece of code will Debug.Print all the words that are underlined and formatted italic in any of the given cells:
Option Explicit
Public Sub tmpSO()
Dim i As Long
Dim j As Range
Dim StartPoint As Long
Dim InItalicUnderlinedWord As Boolean
For Each j In ThisWorkbook.Worksheets(1).Range("C1:C105")
If Len(j.Value2) > 0 Then
For i = 1 To Len(j.Value2)
If j.Characters(i, 1).Font.Italic And j.Characters(i, 1).Font.Underline Then
If InItalicUnderlinedWord = False Then
StartPoint = i
InItalicUnderlinedWord = True
End If
Else
If InItalicUnderlinedWord = True Then
Debug.Print Mid(j.Value2, StartPoint, i - StartPoint)
InItalicUnderlinedWord = False
End If
End If
If InItalicUnderlinedWord = True And i = Len(j.Value2) Then
Debug.Print Mid(j.Value2, StartPoint, i - StartPoint + 1)
InItalicUnderlinedWord = False
End If
Next i
End If
Next j
End Sub
Debug.Print will output the italic and underlined word into the immediate window of the VBE. If you want these words anywhere else then you'll have to adjust the code in two (!) places:
Once in the section which starts with InItalicUnderlinedWord for any find anywhere within a cell and
in the section which starts with If InItalicUnderlinedWord = True And i = Len(j.Value2) Then for any occurrences where the last character in a cell is also underlined and italic.
Let me know if you have any questions or problems.

Answer 2

something like this, only does 1 cell, so you'll need to add it to your loop
Sub test()
Dim r As Range
Dim v As Variant
Dim i As Integer
Dim f As Integer
Set r = Range("h2")
v = Split(r.Value, Chr(32))
For i = 0 To UBound(v) - 1
f = InStr(1, r, v(i)) ' equiv Application.WorksheetFunction.Search(v(i), r)
If r.Characters(f, 1).Font.Italic Then
Debug.Print v(i) & " is italic"
End If
Next i
End Sub

Answer 3

A slightly simpler implementation involves copying the entire cell values first, and then manipulating the copied range. Call this in a loop, and provide it the two arguments: rngToCopy = the cell being copied and rngToPaste the destination cell (qualified to specific workbook/worksheet):
For each cl in Range("C1:C105")
Call CopyItalicUnderlined(cl, __Some Place Else__)
Next
Here's the procedure
Sub CopyItalicUnderlined(rngToCopy, rngToPaste)
rngToCopy.Copy rngToPaste
Dim i
For i = Len(rngToCopy.Value2) To 1 Step -1
With rngToPaste.Characters(i, 1)
If Not .Font.Italic And Not .Font.Underline Then
.Text = vbNullString
End If
End With
Next
End Sub