Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
multiple cells text to text in one cell
Hi Group,
Have a table with abt 5000 posts that need to be edited. The structure of the table is: A B C 1 100 aaaaaa xxxxx bbbbbbbbb yyyyyyyyy ccc Looking for a result like this after editing A B C 1 100 aaaaaa bbbbbbbbb ccc xxxxx yyyyyyyyy The result in row 1 should be the identifing number and two joined text strings in separate columns. Have looked round in the group and found the code below but has not been able to modify it for the purpose. Grateful for some hints, Brgds CG Rosen '---------------------------------------------------------------------------------------------- Sub testme() Dim CurWks As Worksheet Dim NewWks As Worksheet Dim DestCell As Range Dim BigArea As Range Dim SmallArea As Range Dim myCell As Range Dim myStr As String Dim myDelimiter As String Set CurWks = Worksheets("Sheet1") Set NewWks = Worksheets.Add Set DestCell = NewWks.Range("A1") myDelimiter = " " With CurWks Set BigArea = Nothing On Error Resume Next Set BigArea = .Columns(3).Cells.SpecialCells(xlCellTypeConstants ) On Error GoTo 0 If BigArea Is Nothing Then MsgBox "No constants in column A" Exit Sub End If For Each SmallArea In BigArea.Areas myStr = "" For Each myCell In SmallArea.Cells myStr = myStr & myDelimiter & myCell.Value Next myCell If myStr < "" Then myStr = Mid(myStr, Len(myDelimiter) + 1) End If DestCell.Value = myStr Set DestCell = DestCell.Offset(1, 0) Next SmallArea End With End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
multiple cells text to text in one cell
Hi Don,
Thanks a lot. Works perfect Brgds CG Rosen "Don Guillett" skrev i meddelandet ... try this Sub lineemep() dim lr as long dim i as long lr = Cells.Find("*", Cells(Rows.Count, Columns.Count) _ , , , xlByRows, xlPrevious).Row For i = lr To 2 Step -1 If Len(Application.Trim(Cells(i, 1))) <= 1 Then Cells(i - 1, 2) = Cells(i - 1, 2) & " " & Cells(i, 2) Cells(i - 1, 3) = Cells(i - 1, 3) & " " & Cells(i, 3) Rows(i).Delete End If Next i Columns(1).Resize(, 3).AutoFit End Sub -- Don Guillett Microsoft MVP Excel SalesAid Software "CG Rosen" wrote in message ... Hi Group, Have a table with abt 5000 posts that need to be edited. The structure of the table is: A B C 1 100 aaaaaa xxxxx bbbbbbbbb yyyyyyyyy ccc Looking for a result like this after editing A B C 1 100 aaaaaa bbbbbbbbb ccc xxxxx yyyyyyyyy The result in row 1 should be the identifing number and two joined text strings in separate columns. Have looked round in the group and found the code below but has not been able to modify it for the purpose. Grateful for some hints, Brgds CG Rosen '---------------------------------------------------------------------------------------------- Sub testme() Dim CurWks As Worksheet Dim NewWks As Worksheet Dim DestCell As Range Dim BigArea As Range Dim SmallArea As Range Dim myCell As Range Dim myStr As String Dim myDelimiter As String Set CurWks = Worksheets("Sheet1") Set NewWks = Worksheets.Add Set DestCell = NewWks.Range("A1") myDelimiter = " " With CurWks Set BigArea = Nothing On Error Resume Next Set BigArea = .Columns(3).Cells.SpecialCells(xlCellTypeConstants ) On Error GoTo 0 If BigArea Is Nothing Then MsgBox "No constants in column A" Exit Sub End If For Each SmallArea In BigArea.Areas myStr = "" For Each myCell In SmallArea.Cells myStr = myStr & myDelimiter & myCell.Value Next myCell If myStr < "" Then myStr = Mid(myStr, Len(myDelimiter) + 1) End If DestCell.Value = myStr Set DestCell = DestCell.Offset(1, 0) Next SmallArea End With End Sub |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
multiple cells text to text in one cell
Glad to help.
-- Don Guillett Microsoft MVP Excel SalesAid Software "CG Rosen" wrote in message ... Hi Don, Thanks a lot. Works perfect Brgds CG Rosen "Don Guillett" skrev i meddelandet ... try this Sub lineemep() dim lr as long dim i as long lr = Cells.Find("*", Cells(Rows.Count, Columns.Count) _ , , , xlByRows, xlPrevious).Row For i = lr To 2 Step -1 If Len(Application.Trim(Cells(i, 1))) <= 1 Then Cells(i - 1, 2) = Cells(i - 1, 2) & " " & Cells(i, 2) Cells(i - 1, 3) = Cells(i - 1, 3) & " " & Cells(i, 3) Rows(i).Delete End If Next i Columns(1).Resize(, 3).AutoFit End Sub -- Don Guillett Microsoft MVP Excel SalesAid Software "CG Rosen" wrote in message ... Hi Group, Have a table with abt 5000 posts that need to be edited. The structure of the table is: A B C 1 100 aaaaaa xxxxx bbbbbbbbb yyyyyyyyy ccc Looking for a result like this after editing A B C 1 100 aaaaaa bbbbbbbbb ccc xxxxx yyyyyyyyy The result in row 1 should be the identifing number and two joined text strings in separate columns. Have looked round in the group and found the code below but has not been able to modify it for the purpose. Grateful for some hints, Brgds CG Rosen '---------------------------------------------------------------------------------------------- Sub testme() Dim CurWks As Worksheet Dim NewWks As Worksheet Dim DestCell As Range Dim BigArea As Range Dim SmallArea As Range Dim myCell As Range Dim myStr As String Dim myDelimiter As String Set CurWks = Worksheets("Sheet1") Set NewWks = Worksheets.Add Set DestCell = NewWks.Range("A1") myDelimiter = " " With CurWks Set BigArea = Nothing On Error Resume Next Set BigArea = .Columns(3).Cells.SpecialCells(xlCellTypeConstants ) On Error GoTo 0 If BigArea Is Nothing Then MsgBox "No constants in column A" Exit Sub End If For Each SmallArea In BigArea.Areas myStr = "" For Each myCell In SmallArea.Cells myStr = myStr & myDelimiter & myCell.Value Next myCell If myStr < "" Then myStr = Mid(myStr, Len(myDelimiter) + 1) End If DestCell.Value = myStr Set DestCell = DestCell.Offset(1, 0) Next SmallArea End With End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Count single Text in cells with multiple text entries | Excel Discussion (Misc queries) | |||
seperating text in one cell to multiple cells | Excel Discussion (Misc queries) | |||
How can I change text to proper text in multiple cells. | Excel Discussion (Misc queries) | |||
How to input additional text to multiple of existing cells that has text | Excel Worksheet Functions | |||
INTRICATE PROBLEM- How to find multiple text,excluding "H", in a multiple range of cells, then replacing 0 with another number in another cell | Excel Worksheet Functions |