Array splitting and extracting

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

You'll need to get the last char of italics etc, so you'll need to continue your loop I believe, then you can use MID Sorry, ignore that, you're splitting by space, you'll need to paste the split values into a worksheet to do what you are trying. You could use FIND or SEARCH on the cell you've split for the first position of each word, and check that. So split A1, then loop the array, getting the position of the word in A1, then check the first char of that. — Nathan_Sav
– Nathan_Sav, Commented Aug 2, 2016 at 15:49
I see a few things logically wrong with your approach, but can you give more detail on what you're trying to accomplish? Where do you want to move the italicized text? — David Zemens
– David Zemens, Commented Aug 2, 2016 at 15:58
@David Zemens There are multiple words in the cell and im moving the italicized and underlined words to a new sheet. — johndoe253
– johndoe253, Commented Aug 2, 2016 at 16:01
moving words that are italicized and underlined, or moving words that are italicized or underlined? — David Zemens
– David Zemens, Commented Aug 2, 2016 at 16:05

Ralph · Accepted Answer · 2016-08-02 16:25:09Z

2

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.

answered Aug 2, 2016 at 16:25

Ralph

9,4544 gold badges35 silver badges42 bronze badges

Sign up to request clarification or add additional context in comments.

4 Comments

johndoe253 Over a year ago

Thank you! I'm having an error come up "Unable to get the characters property of the range class". Do you know what that means?

Ralph Over a year ago

Just a wild guess: the cell is protected and / or the sheet is protected (or the file as a whole). If that's not the case then you might want to share with us the content of the cell(s) which give(s) you problem(s).

johndoe253 Over a year ago

It actually seems to be running without errors now but how can I change the lines you suggested to move the words to a new sheet?

Ralph Over a year ago

Depends where you want them to be posted. For example: if you want them on Worksheet(1) in column A to be added then use ThisWorkbook.Worksheets(1).Cells(ThisWorkbook.Worksheets(1).Rows.Count, 1).End(xlUp).Offset(1, 0).Value2 instead of Debug.Print in both cases. So, for example instead of Debug.Print Mid(j.Value2, StartPoint, i - StartPoint) just use

ThisWorkbook.Worksheets(1).Cells(ThisWorkbook.Worksheets(1).Rows.Count, 1).End(xlUp).Offset(1, 0).Value2 = Mid(j.Value2, StartPoint, i - StartPoint)

.

Nathan_Sav · Accepted Answer · 2016-08-02 15:58:12Z

1

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

answered Aug 2, 2016 at 15:58

Nathan_Sav

8,5762 gold badges18 silver badges22 bronze badges

Comments

David Zemens · Accepted Answer · 2016-08-02 17:16:36Z

1

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

answered Aug 2, 2016 at 17:16

David Zemens

53.8k12 gold badges86 silver badges132 bronze badges

9 Comments

johndoe253 Over a year ago

You're saying that I should put this into a loop? I'm not exactly how you mean. @DavidZemens

David Zemens Over a year ago

Call the procedure in a loop, as I have done in the example. The first snippet is For Each cl in .... That's the loop which calls the CopyItalicUnderlined procedure. You'll of course need to add the new procedure to the VBProject.

johndoe253 Over a year ago

So in the call (cl, _ some place else _) do I just place the location of where to paste?

David Zemens Over a year ago

yes, _some_place_else_ should be modified to a valid range destination.

johndoe253 Over a year ago

It runs but stops after 2 cells and it doesn't split each instance into a new cell. It seems to just copy a cell with an underline in one of the words. Do you think splitting the cells and then going by character using your code would work?

|

Collectives™ on Stack Overflow

Array splitting and extracting

3 Answers 3

4 Comments

Comments

9 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

4 Comments

Comments

9 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related