Here's a starting point. I assumed that the data is in one column and 2 rows
and the result is in the row immediately after the last row you selected.
Just select two rows and one column of data and run. It's not quite what I'd
like to have, but that exercise is left to you.
Option Explicit
Option Base 1
Sub CombineSelectedRows()
Dim myRange As Excel.Range
Dim r As Excel.Range
Dim myChar As String
Dim myCount As Long
Dim i As Long
Dim begCount As Long
Dim endCount As Long
Dim aCount As Long
Dim myArray() As String
Dim myString As String
Dim myString1 As String
Dim myString2 As String
Dim Match As Boolean
Dim j As Long
Dim lRow As Long
'Assumes data is in column 1
Set myRange = Selection
If myRange.Rows.Count <> 2 And myRange.Count <> 2 Then
MsgBox ("Select a range of 2 rows and one column wide and run again.")
Exit Sub
End If
aCount = 1
For Each r In myRange
myCount = Len(r.Text)
myString = r.Text
begCount = 1
endCount = 0
For i = 1 To myCount
begCount = 1
endCount = InStr(myString, " ")
If endCount = 0 Then
endCount = Len(myString) + 1
End If
myChar = Mid(myString, begCount, endCount - begCount)
Debug.Print begCount, endCount
If aCount = 1 Then
ReDim Preserve myArray(1 To aCount)
myArray(aCount) = myChar
Debug.Print myArray(aCount)
aCount = aCount + 1
Else
End If
'aCount = aCount + 1
Match = False
For j = 1 To UBound(myArray())
If myArray(j) = myChar Then
Match = True
Exit For
End If
Next j
If Not Match Then
'aCount = aCount + 1
ReDim Preserve myArray(1 To aCount)
myArray(aCount) = myChar
aCount = aCount + 1
End If
Debug.Print myString
If Len(myString) > endCount Then
myString = Right(myString, Len(myString) - endCount)
Debug.Print myString
Else
Exit For
End If
Next i
For j = 1 To aCount - 1
Debug.Print j, myArray(j)
Next j
Next r
'Sort the array
For i = 1 To UBound(myArray()) - 1
For j = i + 1 To UBound(myArray())
myString1 = myArray(i)
myString2 = myArray(j)
Debug.Print myString1, myString2
If myString1 > myString2 Then
myArray(j) = myString1
myArray(i) = myString2
End If
Next j
Next i
myString = ""
For i = 1 To UBound(myArray())
Debug.Print i, myArray(i)
If myString = "" Then
myString = myArray(i)
Else
myString = myString & " " & myArray(i)
End If
Next i
lRow = 0
For Each r In myRange
If r.Row > lRow Then
lRow = r.Row
End If
Next r
lRow = lRow + 1
Application.EnableEvents = False
ActiveSheet.Cells(lRow, myRange.Column).Value = myString
Application.EnableEvents = True
End Sub
