text sort

[Continental Translations]

I have some text in each cell in a column. The first few words in the cell
are in bold and the rest are normal text. Is there anyway I can move all the
non-bold text from column A into column B, and leave the bold text in column
A?

Thanks

 

[CLR]

If you have the same number of characters made bold in each row, then you
might use data > Text to columns > Fixed width, and set the column break
where you want them.........otherwise, if you don't have too many rows, you
might go in and manually insert a semicolon, or comma or something between
the bold and normal text ,(or one may already exist), and do Data > Text to
columns > Delimited .....and use that character as the
delimiter........"or", you can just do data > Text to columns > and use
space as a delimiter and separate each word into it's own column, and then
concatenate the groups you want back together

Vaya con Dios,
Chuck, CABGx3

 

[Bob Phillips]

Another approach

Sub ParseBold()
Dim cell As Range
Dim i As Long
On Error Resume Next
For Each cell In Selection
i = 1
Do Until cell.Characters(i, 1).Font.Bold = False Or i >
Len(cell.Value)
i = i + 1
Loop
If i <= Len(cell.Value) Then
cell.Value = Left(cell.Value, i - 1) & "¬" & Mid(cell.Value, i,
255)
End If
Next cell
Selection.TextToColumns Destination:=Selection.Cells(1, 1), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=True, _
Semicolon:=False, _
Comma:=False, _
Space:=False, _
Other:=True, _
OtherChar:="¬", _
FieldInfo:=Array(Array(1, 1), Array(2, 1))
ActiveWindow.WindowState = xlNormal
ActiveWindow.WindowState = xlNormal
End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Continental Translations]

The number of characters in each cell is different and there are over 2000
cells with info in them.

Is there maybe a Macro which can do this?

 

[Bob Phillips]

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Bob Phillips]

See Don's and my replies.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Don Guillett]

Guess you didn't like the macro solutions already presented.

 

[EARTHWALKER]

Probably he's not familiar with how to set up a macro script within VBA
Most people know a macro as record...do stuff and then stop.
Actually, that would include me :

 

[Don Guillett]

alt f11
right click on the vbaproject(filename)
insert
module
copy/paste the macro
save
use alt f8 to execute or assign to button/shape

 

[Continental Translations]

Am I missing something?

I've just looked through all the suggestions and can't find a Macro
presented anywhere.

Can anyone repost it?

alt f11
right click on the vbaproject(filename)
insert
module
copy/paste the macro
save
use alt f8 to execute or assign to button/shape

 

[Don Guillett]

Re-posted with copy to address given
Modify from F1:F? range to suit

Sub ParseBold()'Don Guillett (TESTED)
On Error Resume Next
lr = Cells(Rows.Count, "f").End(xlUp).Row
For Each c In Range("f1:f" & lr)
For i = 1 To Len(c) Step 1
If c.Characters(Start:=i, Length:=1) _
..Font.Bold = True Then
y = i
If i > y Then
z = i
Else
z = y
End If
End If
Next
If z > 0 Then
c.Offset(0, 1) = Trim(Right(c, Len(c) - z))
c.Value = Left(c, z)
End If
Next c
End Sub
===
Sub ParseBold_BobPhillips() 'I did NOT test
Dim cell As Range
Dim i As Long
On Error Resume Next
For Each cell In Selection
i = 1
Do Until cell.Characters(i, 1).Font.Bold = False Or i

Len(cell.Value)

i = i + 1
Loop
If i <= Len(cell.Value) Then
cell.Value = Left(cell.Value, i - 1) & "¬" & Mid(cell.Value,
i,255)
End If
Next cell
Selection.TextToColumns Destination:=Selection.Cells(1, 1), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=True, _
Semicolon:=False, _
Comma:=False, _
Space:=False, _
Other:=True, _
OtherChar:="¬", _
FieldInfo:=Array(Array(1, 1), Array(2, 1))
ActiveWindow.WindowState = xlNormal
ActiveWindow.WindowState = xlNormal
End Sub


--
Don Guillett
SalesAid Software
(e-mail address removed)

Am I missing something?

I've just looked through all the suggestions and can't find a Macro
presented anywhere.

Can anyone repost it?

 

[Bob Phillips]

Here is mine re-posted

Another approach

Sub ParseBold()
Dim cell As Range
Dim i As Long
On Error Resume Next
For Each cell In Selection
i = 1
Do Until cell.Characters(i, 1).Font.Bold = False Or i >
Len(cell.Value)
i = i + 1
Loop
If i <= Len(cell.Value) Then
cell.Value = Left(cell.Value, i - 1) & "¬" & Mid(cell.Value, i,
255)
End If
Next cell
Selection.TextToColumns Destination:=Selection.Cells(1, 1), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=True, _
Semicolon:=False, _
Comma:=False, _
Space:=False, _
Other:=True, _
OtherChar:="¬", _
FieldInfo:=Array(Array(1, 1), Array(2, 1))
ActiveWindow.WindowState = xlNormal
ActiveWindow.WindowState = xlNormal
End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

Am I missing something?

I've just looked through all the suggestions and can't find a Macro
presented anywhere.

Can anyone repost it?