-
list of words relating to font and font size
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.
-
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.
-
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
-
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
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules