Make Bullet Points - change Code

[Stefan_Sand]

Hi all,
i have this wonderfull code to make Bullet Points in an active cell (see below).
How do i have to alter it, to get bullet points into a marked or used range?

Stefan



Sub MakeBullets()

Dim vntLines As Variant
Dim lngIndex As Long
Dim strTemp As String

vntLines = Split(ActiveCell.Value, vbLf)
For lngIndex = LBound(vntLines) To UBound(vntLines)
If Len(Trim(vntLines(lngIndex))) > 0 Then
strTemp = strTemp & ChrW(127) & " " & vntLines(lngIndex) & vbLf
Else
strTemp = strTemp & vbLf
End If
Next
ActiveCell.Value = Left(strTemp, Len(strTemp) - 1)

End Sub

[HansV]

Like this:

Code: Select all

Sub MakeBulletsInCell(rng As Range)
  Dim vntLines As Variant
  Dim lngIndex As Long
  Dim strTemp As String
  If rng.Count > 1 Then Exit Sub
  vntLines = Split(rng.Value, vbLf)
  For lngIndex = LBound(vntLines) To UBound(vntLines)
    If Len(Trim(vntLines(lngIndex))) > 0 Then
      strTemp = strTemp & ChrW(127) & " " & vntLines(lngIndex) & vbLf
    Else
      strTemp = strTemp & vbLf
    End If
  Next lngIndex
  rng.Value = Left(strTemp, Len(strTemp) - 1)
End Sub

Sub MakeBulletsInSelection()
  Dim rng As Range
  For Each rng In Selection
    MakeBulletsInCell rng
  Next rng
End Sub

[Stefan_Sand]

cool, thanks,
hans

[HansV]

The code that I posted will fail if there are empty cells within the selection. The following version takes care of that, and it uses a conventional bullet:

Code: Select all

Sub MakeBullets(rng As Range)
  Dim vntLines As Variant
  Dim lngIndex As Long
  Dim strTemp As String
  If rng.Count > 1 Then Exit Sub
  If rng.Value = "" Then Exit Sub
  vntLines = Split(rng.Value, vbLf)
  For lngIndex = LBound(vntLines) To UBound(vntLines)
    If Len(Trim(vntLines(lngIndex))) > 0 Then
      strTemp = strTemp & Chr(149) & " " & vntLines(lngIndex) & vbLf
    Else
      strTemp = strTemp & vbLf
    End If
  Next lngIndex
  rng.Value = Left(strTemp, Len(strTemp) - 1)
End Sub

Sub MakeBulletsInSelection()
  Dim rng As Range
  For Each rng In Selection
    MakeBullets rng
  Next rng
End Sub

[Stefan_Sand]

thank you again, superb