Reversing Words

[Todd Huttenstine]

Hey guys in Range B5:B105 I have a list of names. They
are formatted as Lastname/Firstname. I need a code that
will go through all the names in this range and reverse
the order of the names.

For example... Huttenstine Todd needs to turn into Todd
Huttenstine

Tom gave me a code that took the commas out, but this time
there are no commas to take out.

Thank you.


Todd

 

[Tom Ogilvy]

Assuming the two words are separated by a space:

Sub ReverseName()
Dim sStr As String
Dim cell As Range
For Each cell In Range("B5:B105")
If Not IsEmpty(cell) Then
If InStr(cell, " ") Then
sStr = Right(cell, Len(cell) _
- InStr(cell, " "))
cell.Value = Trim(sStr) & " " & _
Trim(Left(cell, _
InStr(cell, " ") - 1))
End If
Else
Exit For
End If
Next

End Sub

 

[Todd Huttenstine]

Thanx

-----Original Message-----
Assuming the two words are separated by a space:

Sub ReverseName()
Dim sStr As String
Dim cell As Range
For Each cell In Range("B5:B105")
If Not IsEmpty(cell) Then
If InStr(cell, " ") Then
sStr = Right(cell, Len(cell) _
- InStr(cell, " "))
cell.Value = Trim(sStr) & " " & _
Trim(Left(cell, _
InStr(cell, " ") - 1))
End If
Else
Exit For
End If
Next

End Sub

--
Regards,
Tom Ogilvy




.

 

[Rocky McKinley]

This is another alternative...

Sub ReverseWords()
For Each cell In Range("B5:B105")
cell.Value = ReturnWord(cell.Value, 2) & " " & ReturnWord(cell.Value, 1)
Next
End Sub

Function ReturnWord(MainString As Variant, WordNumber As Integer)
Dim LastChr As String, StartChrReturn As Integer, EndChrReturn As Integer,
Cnt As Integer, _
I As Integer, LeftWord As String, RightWord As String
MainString = " " & Trim(MainString) & " ": LastChr = "": Cnt = 0

For I = 1 To Len(MainString)
If Mid(MainString, I, 1) = " " And LastChr <> " " Then
Cnt = Cnt + 1
If Cnt = WordNumber Then StartChrReturn = I
If Cnt = WordNumber + 1 Then EndChrReturn = I
End If
LastChr = Mid(MainString, I, 1)
Next I
On Error GoTo ErrorHandler:
ReturnWord = Trim(Mid(MainString, StartChrReturn, EndChrReturn -
StartChrReturn))
Exit Function
ErrorHandler:
ReturnWord = ""
End Function

 

[Thomas]

Or a shorter alternative:

Sub ReverseWords()
On Error Resume Next
Dim i As Variant
For Each rng In [B1:B105]
i = InStr(1, rng, " ")
rng.Value = Mid(rng, i + 1) & " " & Left(rng, i - 1)
Next
End Sub

 

[Rocky McKinley]

Yours ReverseWords sub is better for use in one specific instance for sure.

My ReturnWord function is meant to be reuseable in many different more
generic ways. ReturnWord will pull any word number (like 3 for the third
word in a text string) from a text string, it also eliminates leading
spaces, trailing spaces and multiple spaces between words.

If I was using the code only in this one specific instance I would certainly
choose your code Thomas, it is definately tighter.

--
Regards,
Rocky McKinley

Or a shorter alternative:

Sub ReverseWords()
On Error Resume Next
Dim i As Variant
For Each rng In [B1:B105]
i = InStr(1, rng, " ")
rng.Value = Mid(rng, i + 1) & " " & Left(rng, i - 1)
Next
End Sub

This is another alternative...

Sub ReverseWords()
For Each cell In Range("B5:B105")
cell.Value = ReturnWord(cell.Value, 2) & " " & ReturnWord(cell.Value, 1)
Next
End Sub

Function ReturnWord(MainString As Variant, WordNumber As Integer)
Dim LastChr As String, StartChrReturn As Integer, EndChrReturn As Integer,
Cnt As Integer, _
I As Integer, LeftWord As String, RightWord As String
MainString = " " & Trim(MainString) & " ": LastChr = "": Cnt = 0

For I = 1 To Len(MainString)
If Mid(MainString, I, 1) = " " And LastChr <> " " Then
Cnt = Cnt + 1
If Cnt = WordNumber Then StartChrReturn = I
If Cnt = WordNumber + 1 Then EndChrReturn = I
End If
LastChr = Mid(MainString, I, 1)
Next I
On Error GoTo ErrorHandler:
ReturnWord = Trim(Mid(MainString, StartChrReturn, EndChrReturn -
StartChrReturn))
Exit Function
ErrorHandler:
ReturnWord = ""
End Function