thanks
the result is corrected but, the values would have to be one for cell
in the row immediately after the last row

by
john

On Sun, 14 Feb 2010 10:09:01 -0800, ?B?QmFyYiBSZWluaGFyZHQ=?= wrote:

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

--
HTH,

Barb Reinhardt



"john" wrote:

I have two lines of data
Hello

I mast combine 2 rows with a macro vba and
create a third row with the data in increasing order, and delete the equal elements

example

row 1

E100001 E200120 E200124 E200127 E200152

Rows 2

E100001 E100101 E200120 E200124 E200127 E260250



Result in row 3

E100001 E100101 E200120 E200124 E200127 E200152 E260250

thanks
John

.