Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
combine two row in one
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
combine two row in one
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 . |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
combine two row in one
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 . |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How do I combine worksheets w/o enough rows to combine? | Excel Worksheet Functions | |||
Combine if | Excel Discussion (Misc queries) | |||
Combine cells with the same reference and combine quantities | Excel Discussion (Misc queries) | |||
Combine into one please | Excel Worksheet Functions | |||
combine an IF and SUM | Excel Programming |