Double names to single

[Lowggy]

Does anyone know of a way to take a list of names of couples with the same last name that are on two adjacent rows in an Excel file and turn it into a single line.

Ie John Smith
Sharon Smith

to Smiths, John and Sharon

Thanks.

 

[ranman256]

try this....it places the result 2 columns to the right of A.

Sub NameJoin()
Dim bEnd As Boolean
Dim vPrevLast, vLast, vFirst, vBoth, vName, vPrevName
Dim i As Integer


Range("A2").Select
While ActiveCell.Value <> ""
   
   vName = ActiveCell.Value
   i = InStr(vName, " ")
   vFirst = Left(vName, i - 1)
   vLast = Mid(vName, i + 1)
   
   If vLast <> vPrevLast Then
       If bEnd Then
         vBoth = vPrevName
         ActiveCell.Offset(0, 2).Value = vBoth
         bEnd = False
       End If
       
         vBoth = vLast & ", " & vFirst & " and "
         bEnd = True
   Else
     If bEnd Then
        vBoth = vBoth & vFirst
        ActiveCell.Offset(0, 2).Value = vBoth
        vBoth = ""
     
        bEnd = False
     End If
     
   End If
   vPrevName = vLast & ", " & vFirst
   vPrevLast = vLast
   
   ActiveCell.Offset(1, 0).Select   'next row
Wend
End Sub

 

[Lowggy]

try this....it places the result 2 columns to the right of A.

Sub NameJoin()
Dim bEnd As Boolean
Dim vPrevLast, vLast, vFirst, vBoth, vName, vPrevName
Dim i As Integer


Range("A2").Select
While ActiveCell.Value <> ""
   
   vName = ActiveCell.Value
   i = InStr(vName, " ")
   vFirst = Left(vName, i - 1)
   vLast = Mid(vName, i + 1)
   
   If vLast <> vPrevLast Then
       If bEnd Then
         vBoth = vPrevName
         ActiveCell.Offset(0, 2).Value = vBoth
         bEnd = False
       End If
       
         vBoth = vLast & ", " & vFirst & " and "
         bEnd = True
   Else
     If bEnd Then
        vBoth = vBoth & vFirst
        ActiveCell.Offset(0, 2).Value = vBoth
        vBoth = ""
     
        bEnd = False
     End If
     
   End If
   vPrevName = vLast & ", " & vFirst
   vPrevLast = vLast
   
   ActiveCell.Offset(1, 0).Select   'next row
Wend
End Sub

I must be doing something wrong because this did not work. I copied your code. I opened my Excel sheet, went to developer mode, clicked on Visual Basic, then sheet 1 and did an insert module and then pasted the code. When I run the macro it just puts the names, in the exact same format I had them in, into the third column over. What am I doing wrong?

 

[Lowggy]

I must be doing something wrong because this did not work. I copied your code. I opened my Excel sheet, went to developer mode, clicked on Visual Basic, then sheet 1 and did an insert module and then pasted the code. When I run the macro it just puts the names, in the exact same format I had them in, into the third column over. What am I doing wrong?

try this....it places the result 2 columns to the right of A.

Sub NameJoin()
Dim bEnd As Boolean
Dim vPrevLast, vLast, vFirst, vBoth, vName, vPrevName
Dim i As Integer


Range("A2").Select
While ActiveCell.Value <> ""
   
   vName = ActiveCell.Value
   i = InStr(vName, " ")
   vFirst = Left(vName, i - 1)
   vLast = Mid(vName, i + 1)
   
   If vLast <> vPrevLast Then
       If bEnd Then
         vBoth = vPrevName
         ActiveCell.Offset(0, 2).Value = vBoth
         bEnd = False
       End If
       
         vBoth = vLast & ", " & vFirst & " and "
         bEnd = True
   Else
     If bEnd Then
        vBoth = vBoth & vFirst
        ActiveCell.Offset(0, 2).Value = vBoth
        vBoth = ""
     
        bEnd = False
     End If
     
   End If
   vPrevName = vLast & ", " & vFirst
   vPrevLast = vLast
   
   ActiveCell.Offset(1, 0).Select   'next row
Wend
End Sub