Combining Cells on Loop until Last Character equal >

keeblerkev

New Member
Joined
Apr 2, 2012
Messages
23
Hello,

I have had great success with people's help on this site and hoping the success continues with this problem. I have two parts to my spreadsheet that I am struggling with in regardsin to combining cells.

Part 1:
My spreadsheet comes looking like this below:
| A | B | C | D | E |...
|<FONT>How | Who | What | Why | ?<BR></FONT></P> |

I need this to be combined all in one cell to read: <FONT>How, What, Why, ?<BR></FONT></P> (Including commas between values that were in separate cells)

The catch is that in this example it goes to Column E, but it various from each spreadsheet on where the question ends. The constants is that the question always starts at Coulmn D and the last cell always ends with </P>.

Is there a way to run a loop to combine these cells until the last character is ">"?

PART 2:
Following the combining in part 1, I need a loop that will combine cells until it reaches a blank cell. Once part 1 works, the constant would be that this data would start in Column E and then continue until a blank cell.

Please let me know if i my dreams of making this spreadsheet user friendly is just out of reach.

Thank you,
Kev
 

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
This is for Data whose first row starts in "A1" and subsequent rows in "E2" down.
Each row of Data could be of different lenghts
With the results all in column "A" & "E".
Code:
[COLOR=navy]Sub[/COLOR] MG03Apr16
[COLOR=navy]Dim[/COLOR] Rng         [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Dn          [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] RngAc       [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Temp        [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Union(Range("A1"), Range(Range("E2"), Range("E" & Rows.Count).End(xlUp)))
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
        [COLOR=navy]Set[/COLOR] RngAc = Range(Dn, Cells(Dn.Row, Columns.Count).End(xlToLeft))
            Temp = Join(Application.Transpose(Application.Transpose(RngAc)), ",")
                RngAc.ClearContents
                    Dn = Temp
    [COLOR=navy]Next[/COLOR] Dn
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Last edited:

keeblerkev

New Member
Joined
Apr 2, 2012
Messages
23
Hi MickG,

This is helpful, but my data may not end at Column E, it may go to H or Q or even end at C. It varies depending on which source the data is coming from.

So I need a code that will keep combining until it reaches the ">" which is the only constant in these reports.

Thank you for your help,
Kev
 

CharlesChuckieCharles

Well-known Member
Joined
May 10, 2011
Messages
2,153
Code:
Function jointhecells(StartPoint As Range, ldistance As Long, Optional ByColumn As Boolean, Optional MyDelimiter As String, Optional strStopString As String) As String
Dim myRange As Range
Dim myCell As Range
Dim mystr As String
Dim MyDel As String
Dim bDontStop As Boolean

On Error Resume Next
If ldistance = 0 Then
    ldistance = 500
End If
If IsMissing(MyDelimiter) Then
    MyDel = ""
Else
    MyDel = MyDelimiter
End If
If IsMissing(strStopString) Or strStopString = "" Then
   bDontStop = True
Else
   bDontStop = False
End If

If IsMissing(ByColumn) Or ByColumn = False Then
    'do by row
   'Set myRange = StartPoint.Resize(, (Columns.Count - StartPoint.column))
   Set myRange = StartPoint.Resize(, (ldistance))
Else
    'do by column
    'Set myRange = StartPoint.Resize((Rows.Count - StartPoint.Row))
    Set myRange = StartPoint.Resize((ldistance))
End If

mystr = ""
For Each myCell In myRange
    If Not (bDontStop) And myCell.Value = strStopString Then
        jointhecells = Left(mystr, Len(mystr) - Len(MyDel))
        Exit Function
    Else
        mystr = mystr & Trim(myCell.Value) & MyDel
    End If
    DoEvents
Next myCell
jointhecells = Left(mystr, Len(mystr) - Len(MyDel))
End Function
THis will work as a concatenation function


=JoinTheCells(E2,100,False,", ",">")

use as a spreadsheet function or in VBA code

Range("D2").value=JoinTheCells(E2,100,False,", ",">")

Parameters
Starting Range

Distance in cells (defaults to 500 if you enter 0, using the widths/Depths would break your machine)

FALSE = look along the row
TRUE = look down the column

Separating delimiter example is comma space ", " but any string will do "MickeyMouse_)"

Stopstring in example ">" anagin can be any string as long as its the complete string in the stop cell (you could use an Instr if you want)
 

keeblerkev

New Member
Joined
Apr 2, 2012
Messages
23
Hi MickG,

Here is an example. My original data looks like:
<TABLE style="WIDTH: 672pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=896><COLGROUP><COL style="WIDTH: 48pt" span=14 width=64><TBODY><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; WIDTH: 48pt; HEIGHT: 15pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" height=20 width=64>MUTLIPLE CHOICE: Please select an option or select "Other". Option A


</TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" width=64>Option B</TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" width=64>Option C</TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" width=64>Option D</TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" width=64>Option E</TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" width=64>Option F</TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" width=64>Option G</TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" width=64>Option H</TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" width=64>Option I</TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" width=64>Option J</TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" width=64>Option K</TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" width=64>Option L</TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" width=64>Option M </TD><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8" width=64>Other br> </TD></TR></TBODY></TABLE>
And I need it to look like:


MUTLIPLE CHOICE: Please select an option or select "Other". Option A, Option B, Option C, Option D, Option E, Option F, Option G, Option H, Option I, Option J, Option K, Option L, Option M, Other br>
I hope this helps.

CharlesChuckCharles,

I tried your function, but my spreadsheet just closed. I wonder if it has a limit on the number of data it can process?

Thanks for the help!
Kev
 

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
If your example data is in row (1) try this:-
NB:- This will find all the data in row (1) , If you last cell in the row is always "<" then this will do the trick, else you will posssibly need a loop.

Code:
Dim Temp        As String
Dim RngAc       As Range
        Set RngAc = Range("A1", Cells(1, Columns.Count).End(xlToLeft))
            Temp = Join(Application.Transpose(Application.Transpose(RngAc)), ", ")
             RngAc.ClearContents
               Range("A1") = Temp
End Sub
 

keeblerkev

New Member
Joined
Apr 2, 2012
Messages
23
MickG,

Thanks that worked, but unfortuantely if combined everything in that row. I need it to leave columns A, B, C alone and start at Column D and combine from that point until it reaches a cell with the last character of ">." There is data after the ">" cell that I can't have combined. The example in my data above is starting at column D and ends with the cell that ends in ">."

Is there a possible code for this?

Thanks,
Kev
 

keeblerkev

New Member
Joined
Apr 2, 2012
Messages
23
So I am getting closer. Below is my current code. I can now combine all rows starting at Column D over. The only task I am missing is stopping the combine process once it reaches a cell with the last character = ">" This is not always the last cell in the row, many times I have additional data further in the row, but i don't want this combined.

Any ideas?

Thanks!

Code:
Sub combine()
Dim Temp        As String
Dim RngAc       As Range
Dim Last As Integer
Last = Cells(Rows.Count, "D").End(xlUp).row
       For i = 1 To Last
       On Error Resume Next
          Set RngAc = Range(Cells(i, "D"), Cells(i, Columns.Count).End(xlToLeft))
            Temp = Join(Application.Transpose(Application.Transpose(RngAc)), ", ")
             RngAc.ClearContents
               Cells(i, "D") = Temp
            Next i
    End Sub
 

keeblerkev

New Member
Joined
Apr 2, 2012
Messages
23
Did anyone have any thought? I found this code on another message, but not sure how I can utilize it to work with for the sub I am working on above.

Code:
 For i = cells(rows.count,15).end(xlup).row To 1 Step -1 
    If left(cells(i,15),1) = "A" Then cells(i,15).entirerow.delete 
Next i
Thanks!
 

Forum statistics

Threads
1,082,450
Messages
5,365,600
Members
400,841
Latest member
roadtoexcel

Some videos you may like

This Week's Hot Topics

Top