locked
list of words relating to font and font size RRS feed

  • Question

  • Hi all,

    In A1 I have text that consists of words which all are separated by a space (and nothing else).

    Some words are in font Arial 9, others in Arial 12 (no other fonts or font sizes).

    Form A5 down I need all Ariel 12 words only, and from B5 down I need all Ariel 9 words only.

    Your assistance will be appreciated very much.

    Jack Sons

    Wednesday, September 7, 2016 9:16 AM

Answers

  • My macro changed to remove 160 characters - just in case there are both types of spaces included....

    Sub Macro3()
        Dim i As Long
        Dim j As Long
        Dim a As Long
        Dim b As Long
        Dim v As Variant
        
        a = 5
        b = 5
        j = 1
        
        v = Split(Replace(Range("A1").Value, Chr(160), " "), " ")
        
        For i = LBound(v) To UBound(v)
            If Range("A1").Characters(Start:=j, Length:=1).Font.Size = 9 Then
                Cells(b, "B").Value = v(i)
                b = b + 1
            Else
                Cells(a, "A").Value = v(i)
                a = a + 1
            End If
            j = j + Len(v(i)) + 1
        Next i

    End Sub



    Friday, September 9, 2016 12:53 PM
  • To handle more font sizes/names, you just need to add more row index counters, like

    Sub Macro4()
        Dim i As Long
        Dim j As Long
        
        Dim k As Long
        Dim l As Long
        Dim m As Long
        Dim n As Long
        Dim o As Long
        Dim p As Long
        
        Dim v As Variant
        
        k = 5
        l = 5
        m = 5
        n = 5
        o = 5
        p = 5
        
        j = 1
        
        v = Split(Replace(Range("A1").Value, Chr(160), " "), " ")
        
        For i = LBound(v) To UBound(v)
            If Range("A1").Characters(Start:=j, Length:=1).Font.Name = "Arial" Then
                If Range("A1").Characters(Start:=j, Length:=1).Font.Size = 9 Then
                    Cells(k, "A").Value = v(i)
                    k = k + 1
                End If
                If Range("A1").Characters(Start:=j, Length:=1).Font.Size = 11 Then
                    Cells(l, "B").Value = v(i)
                    l = l + 1
                End If
                If Range("A1").Characters(Start:=j, Length:=1).Font.Size = 12 Then
                    Cells(m, "C").Value = v(i)
                    m = m + 1
                End If
            Else
                If Range("A1").Characters(Start:=j, Length:=1).Font.Size = 9 Then
                    Cells(n, "D").Value = v(i)
                    n = n + 1
                End If
                If Range("A1").Characters(Start:=j, Length:=1).Font.Size = 11 Then
                    Cells(o, "E").Value = v(i)
                    o = o + 1
                End If
                If Range("A1").Characters(Start:=j, Length:=1).Font.Size = 12 Then
                    Cells(p, "F").Value = v(i)
                    p = p + 1
                End If
            End If
            
            j = j + Len(v(i)) + 1
        Next i
        
    End Sub

    • Marked as answer by Jack Sons Thursday, September 15, 2016 1:24 PM
    Wednesday, September 14, 2016 7:18 PM

All replies

  • Hi all,

    In A1 I have text that consists of words which all are separated by a space (and nothing else).

    Some words are in font Arial 9, others in Arial 12 (no other fonts or font sizes).

    Form A5 down I need all Ariel 12 words only, and from B5 down I need all Ariel 9 words only.

    Your assistance will be appreciated very much.

    Jack Sons

    Wednesday, September 7, 2016 9:32 AM
  • Here is a macro you can run:

    Sub SplitOnSize()
        Dim rngCell As Range
        Dim lngPosition As Long
        Dim lngStart As Long
        Dim blnWord As Boolean
        Dim lngFontSize As Long
        Dim lngRowFor9 As Long
        Dim lngRowFor12 As Long
        ' Initialize
        Set rngCell = Range("A1")
        lngRowFor9 = 4
        lngRowFor12 = 4
        ' Loop
        For lngPosition = 1 To rngCell.Characters.Count
            If rngCell.Characters(lngPosition, 1).Text = " " Then
                If blnWord Then
                    If lngFontSize = 9 Then
                        lngRowFor9 = lngRowFor9 + 1
                        Range("A" & lngRowFor9) = rngCell.Characters(lngStart, lngPosition - lngStart).Text
                    Else
                        lngRowFor12 = lngRowFor12 + 1
                        Range("B" & lngRowFor12) = rngCell.Characters(lngStart, lngPosition - lngStart).Text
                    End If
                    blnWord = False
                End If
            Else
                If Not blnWord Then
                    lngStart = lngPosition
                    lngFontSize = rngCell.Characters(lngPosition, 1).Font.Size
                    blnWord = True
                End If
            End If
        Next lngPosition
        ' Last word
        If blnWord Then
            If lngFontSize = 9 Then
                lngRowFor9 = lngRowFor9 + 1
                Range("A" & lngRowFor9) = rngCell.Characters(lngStart, lngPosition - lngStart).Text
            Else
                lngRowFor12 = lngRowFor12 + 1
                Range("B" & lngRowFor12) = rngCell.Characters(lngStart, lngPosition - lngStart).Text
            End If
            blnWord = False
        End If
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Wednesday, September 7, 2016 3:35 PM
  • Try this:

    Sub Macro2()
        Dim i As Long
        Dim j As Long
        Dim a As Long
        Dim b As Long
        Dim v As Variant
        
        a = 5
        b = 5
        j = 1
        
        v = Split(Range("A1").Value, " ")
        
        For i = LBound(v) To UBound(v)
            If Range("A1").Characters(Start:=j, Length:=1).Font.Size = 9 Then
                Cells(b, "B").Value = v(i)
                b = b + 1
            Else
                Cells(a, "A").Value = v(i)
                a = a + 1
            End If
            j = j + Len(v(i)) + 1
        Next i

    End Sub

    Wednesday, September 7, 2016 5:51 PM
  • Thanks Bernie, but by executing the split function all words are converted to my default font and fontsize and they are all put in B5.

    Perhaps possible with do loops that check from space to next space like

    with

    if font=Arial and fontsize=9 then

    But I can't get the corrct code, so I need your further assistance.

    Jack.

     
    Thursday, September 8, 2016 9:21 AM
  • Hi Jack,

    You post 2 same threads in our forum, I merged these 2 threads and please try the code of Hans Vogelaar.

    :)


    Regards,
    Emi Zhang
    TechNet Community Support

    Please remember to mark the replies as answers if they help and unmark them if they provide no help.
    If you have feedback for TechNet Subscriber Support, contact tnmff@microsoft.com.

    Thursday, September 8, 2016 9:37 AM
  • The split just identifies the words, and the code uses the entry in cell A1 to determine the font, which is never changed.  So you don't have any words with a font size that isn't 9.  Here's a test macro to run in a blank workbook:

    Sub MacroTest()
        Dim i As Long
        Dim j As Long
        Dim a As Long
        Dim b As Long
        Dim v As Variant
        
        a = 5
        b = 5
        j = 1
        
        With Range("A1")
            .Value = "This is the entry in cell A1."
            .Font.Size = 12
            .Characters(1, 4).Font.Size = 9
            .Characters(9, 3).Font.Size = 9
            .Characters(19, 2).Font.Size = 9
            .Characters(27, 3).Font.Size = 9
        End With

        
        v = Split(Range("A1").Value, " ")
        
        For i = LBound(v) To UBound(v)
            If Range("A1").Characters(j, 1).Font.Size = 9 Then
                Cells(b, "B").Value = v(i)
                b = b + 1
            Else
                Cells(a, "A").Value = v(i)
                a = a + 1
            End If
            j = j + Len(v(i)) + 1
        Next i

    End Sub


    Thursday, September 8, 2016 1:50 PM
  • Thanks Hans,

    When I run the code it halts in the last word part of the code, see the error messages below.

    I noticed that in my worksheet nothing was changed although execution of the code was almost completed.

    I also noticed that in the line        lngRowFor9 = lngRowFor9 + 1       and in the next line (yellow, see below)

    lngRowFor9 is still equal to 5.

    Please give further assistance.

    Jack.

    Thursday, September 8, 2016 7:37 PM
  • Thanks Bernie,

    I executed the code, see the result below. It is all in my default font and size.

    What does it prove?

    You remarked "So you don't have any words with a font size that isn't 9", but I do have other sizes, see this:

    Jack.

    Thursday, September 8, 2016 7:51 PM
  • Thursday, September 8, 2016 8:22 PM
  • My macro changed to remove 160 characters - just in case there are both types of spaces included....

    Sub Macro3()
        Dim i As Long
        Dim j As Long
        Dim a As Long
        Dim b As Long
        Dim v As Variant
        
        a = 5
        b = 5
        j = 1
        
        v = Split(Replace(Range("A1").Value, Chr(160), " "), " ")
        
        For i = LBound(v) To UBound(v)
            If Range("A1").Characters(Start:=j, Length:=1).Font.Size = 9 Then
                Cells(b, "B").Value = v(i)
                b = b + 1
            Else
                Cells(a, "A").Value = v(i)
                a = a + 1
            End If
            j = j + Len(v(i)) + 1
        Next i

    End Sub



    Friday, September 9, 2016 12:53 PM
  • See the Microsoft Community thread. It turned out that the words are separated by non-breaking spaces instead of ordinary spaces, so the string has to be split on Chr(160).

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Friday, September 9, 2016 12:58 PM
  • Thanks Bernie, I just now saw your answer (and marked it as an answer of course),  it works nice.

    What would your code be if (as is the case, my original question was inaccurate, my apologies) there are three font sizes 9, 11 and 12? And - suppose, it's hypothetical but could occur on another occasion - two fonts, say Arial and Times New Roman?

    Jack Sons.

    Wednesday, September 14, 2016 1:48 PM
  • To handle more font sizes/names, you just need to add more row index counters, like

    Sub Macro4()
        Dim i As Long
        Dim j As Long
        
        Dim k As Long
        Dim l As Long
        Dim m As Long
        Dim n As Long
        Dim o As Long
        Dim p As Long
        
        Dim v As Variant
        
        k = 5
        l = 5
        m = 5
        n = 5
        o = 5
        p = 5
        
        j = 1
        
        v = Split(Replace(Range("A1").Value, Chr(160), " "), " ")
        
        For i = LBound(v) To UBound(v)
            If Range("A1").Characters(Start:=j, Length:=1).Font.Name = "Arial" Then
                If Range("A1").Characters(Start:=j, Length:=1).Font.Size = 9 Then
                    Cells(k, "A").Value = v(i)
                    k = k + 1
                End If
                If Range("A1").Characters(Start:=j, Length:=1).Font.Size = 11 Then
                    Cells(l, "B").Value = v(i)
                    l = l + 1
                End If
                If Range("A1").Characters(Start:=j, Length:=1).Font.Size = 12 Then
                    Cells(m, "C").Value = v(i)
                    m = m + 1
                End If
            Else
                If Range("A1").Characters(Start:=j, Length:=1).Font.Size = 9 Then
                    Cells(n, "D").Value = v(i)
                    n = n + 1
                End If
                If Range("A1").Characters(Start:=j, Length:=1).Font.Size = 11 Then
                    Cells(o, "E").Value = v(i)
                    o = o + 1
                End If
                If Range("A1").Characters(Start:=j, Length:=1).Font.Size = 12 Then
                    Cells(p, "F").Value = v(i)
                    p = p + 1
                End If
            End If
            
            j = j + Len(v(i)) + 1
        Next i
        
    End Sub

    • Marked as answer by Jack Sons Thursday, September 15, 2016 1:24 PM
    Wednesday, September 14, 2016 7:18 PM
  • That's it, thank you Bernie.

    Jack.

    Thursday, September 15, 2016 1:25 PM