Simple Word Editing (Resolved)

[Ricky1]

A progam to change the following to the following.

word_word__

word__

__word

would become

word_word

word

word

i need it to remove all the underscores the begining and the ends of the words. But if a word has an underscore in the middle that stays.

Get me ?

[dglienna]

Where are the words? In a multiline textbox, or rtf, or in a listbox?

[Ricky1]

sorry in a listbox.

[dglienna]

and where are they going? into another listbox, or the same one?

[Ricky1]

same one.

[Ricky1]

Public Sub RemoveRealName()

Dim I As Long
Dim Word As String
For I = 0 To list1.ListCount - 1
X = 0

Do While X < 31

If Left(list1.List(I), 1) = "_" Then
    Word = Right(list1.List(I), Len(list1.List(I)) - 1)
End If

If Right(list1.List(I), 1) = "_" Then
    Word = Left(list1.List(I), Len(list1.List(I)) - 1)
End If

X = X + 1

Loop

list1.List(I) = list1.List(I) & " - " & Word

Next I

End Sub

ok i have worked it out to make it remove the scores but now im trying to do this.
make it loop and change all the scores but then make it do the following.

Word was __Rick_

it changes to Rick by remove the scores like above. But then list(i) becomes original word then a dash and the new word.

__Rick_ - Rick

I tried the code above but it only loops once before it changes list(I) any help ?

[Ricky1]

i need to make it finish the loop before it changes list(i) but it won't do the loop first.

Getting really annoyed lol

[dglienna]

Try this. It leaves multiple underlines in the middle of a word, but you didn't say anything about that.

Option Explicit
 
Private Sub Command1_Click()
  Dim x As Integer, arr() As String, t As Integer
  t = List1.ListCount - 1
  ReDim arr(t)
  For x = 0 To t
    arr(x) = List1.List(x)
  Next x
  List1.Clear
  For x = 0 To t
    List1.AddItem strip(arr(x))
  Next x
End Sub
 
Function strip(w As String) As String
  Dim x As Integer, b As Integer
  Dim str As String, e As Integer
  For x = 1 To Len(w)
    If Mid(w, x, 1) <> "_" Then
       b = x
       Exit For
    End If
  Next x
 For x = Len(w) To 1 Step -1
    If Mid(w, x, 1) <> "_" Then
       e = x
      Exit For
    End If
  Next x
  strip = Mid$(w, b, e - b + 1)
End Function
 
Private Sub Form_Load()
  List1.AddItem "word_word__"
  List1.AddItem "word__"
  List1.AddItem "__word"
  List1.AddItem "word_word__"
End Sub

[Ricky1]

well looking at my code could ya change it to make it work ?

[dglienna]

Sure, just have to change one line.

Option Explicit
 
Private Sub Command1_Click()
  Dim x As Integer, arr() As String, t As Integer
  t = List1.ListCount - 1
  ReDim arr(t)
  For x = 0 To t
    arr(x) = List1.List(x)
  Next x
  List1.Clear
  For x = 0 To t
    List1.AddItem strip(arr(x))
  Next x
End Sub
 
Function strip(w As String) As String
  Dim x As Integer, b As Integer
  Dim str As String, e As Integer
  For x = 1 To Len(w)
    If Mid(w, x, 1) <> "_" Then
       b = x
       Exit For
    End If
  Next x
 For x = Len(w) To 1 Step -1
    If Mid(w, x, 1) <> "_" Then
       e = x
      Exit For
    End If
  Next x
[COLOR=Red]  strip = w & " - " & Mid$(w, b, e - b + 1)
[/COLOR]End Function
 
Private Sub Form_Load()
  List1.AddItem "word_word__"
  List1.AddItem "word__"
  List1.AddItem "__word"
  List1.AddItem "word_word__"
  List1.AddItem "__Rick__"
End Sub

[dglienna]

That takes care of it, doesn't it?