Fixing Bullet Lists with VBA Macro

Hi Craig,

Can you provide some sample data that illustrates what exactly you want to do?

By its own line, do you mean a carriage return so that it wraps to next line INSIDE the cell? or a new row on the spreadsheet?

I just realized when you say "in its own line within the field" that you probably want to keep the text in ONE cell, just with a line feed/carriage return... If I am right then this code should to it?

Option Explicit
Sub craig_bickett()

Dim ws As Worksheet
Dim original_text() As String
Dim new_text As String
Dim lr As Long 'last row with data in the column you are fixing
Dim i As Long
Dim j As Long

Set ws = Worksheets("Sheet1")
lr = ws.Range("A" & Rows.Count).End(xlUp).Row 'change "A" to column with data to fix
For i = lr To 1 Step -1 'assumes no headers, change the 1 to a 2 if you do have headers
    new_text = vbNullString
    original_text = Split(ws.Range("A" & i).Value, "•") 'replace "A" with correct column
    For j = 1 To UBound(original_text)
        If j < UBound(original_text) Then
            new_text = new_text & "•" & original_text(j) & vbCrLf
        Else
            new_text = new_text & "•" & original_text(j)
        End If
    Next j
    ws.Range("A" & i).Value = new_text 'again, replace "A" with the column
Next i
Set ws = Nothing

End Sub

craig,

Glad you got it solved
yes vbcrlf is as you assumed.

Cheers,

Arkadi

Sorry not at a computer just now and while i have ideas, i like to test what i post. I will try to get back to you shortly... Tomorrow morning at the latest

You say sometimes the list is itemized either by double spaces or by numbers.... are the ONLY double spaces in a cell there to divide items? If so, then we can use the same principle to split up those cells in a new loop, I don't know if you want bullets replacing the double spaces to standardize your list? I'm assuming yes... but I'll put in red the pieces to take out if you don't want the bullet put into those:

Sub CleanSpacesA()

Dim sht As Worksheet
Dim original_text() As String
Dim new_text As String
Dim lr As Long
Dim i As Long
Dim j As Long

Set sht = Worksheets("Sheet1")

lr = sht.Range("A" & Rows.Count).End(xlUp).Row 'replace with correct column

i = 1

For i = 1 To lr
With Range("A" & i) 'replace with correct column
.Value = WorksheetFunction.Trim(.Value)
End With
Next i
'separate bullet items into separate rows
For i = lr To 2 Step -1
    new_text = vbNullString
    original_text = Split(sht.Range("A" & i).Value, "•") 'replace with correct column
    For j = 1 To UBound(original_text)
        If j < UBound(original_text) Then
            new_text = new_text & "•" & original_text(j) & vbCrLf
        Else
        new_text = new_text & "•" & original_text(j)
        End If
    Next j
    If UBound(original_text) > 0 Then sht.Range("A" & i).Value = new_text 'replace with correct column
Next i
'separate double space items into separate rows
For i = lr To 2 Step -1
    new_text = vbNullString
    original_text = Split(sht.Range("A" & i).Value, "  ") 'replace with correct column
    For j = 1 To UBound(original_text)
        If j < UBound(original_text) Then
            new_text = new_text & "•" & original_text(j) & vbCrLf
        Else
        new_text = new_text & "•" & original_text(j)
        End If
    Next j
    If UBound(original_text) > 0 Then sht.Range("A" & i).Value = new_text 'replace with correct column
Next i

Set sht = Nothing

End Sub

Please check out the forum rules, it will show you how to add code tags when you paste code so that things are easier to read.

As far as numbers goes, that is a problem, since it is very hard for code to know which numbers are there for the listing of items, and which numbers are part of your valid text. Unless you can guarantee that numbers are ONLY ever used to separate list items and there are NO numbers at all that are part of normal text. Is there any extra criteria we can use to identify those?

craig,

First issue... the lack of bullets resulting in value gettting cleared:
change this line of code:

sht.Range("A" & i).Value = new_text 'replace with correct column

with:

If UBound(original_text) > 0 Then sht.Range("A" & i).Value = new_text 'replace with correct column

this will omit pasting if there was nothing to split.
Silly oversight on my part, I assumed there is always at least one bullet.

Okay, I get why that works that way. Thank you. That pretty much solves my problem.

There aren't many lists using numbers, so I'll just edit those manually.

Originally Posted by craig.bickett

Okay, I get why that works that way. Thank you. That pretty much solves my problem.

There aren't many lists using numbers, so I'll just edit those manually.

Instead of " " in the split code for double space you would put chr(10) without quotes:

Split(sht.Range("A" & i).Value, Chr(10))