Combining Cells on Loop until Last Character equal >

[keeblerkev]

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

 

[keeblerkev]

MickG,

You are amazing! It works. The only thing I need now is to delete the now empty rows and shift left as well as loop the code down coulmn D until the last row so it can duplicate the process for each row.

Any ideas on this last part?

Thank you,
Kev

 

[MickG]

This is the same code as before but now it loops through column "D", combining the rows (Deleting the row infomation up to ">") and places the new strings in column "A" of each row.

[COLOR="Navy"]Sub[/COLOR] MG04Apr06
[COLOR="Navy"]Dim[/COLOR] Temp        [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] RngAc       [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Ac          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("D1"), Range("D" & 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))
         [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Ac [COLOR="Navy"]In[/COLOR] RngAc
                Temp = Temp & ", " & Ac
                [COLOR="Navy"]If[/COLOR] Right(Trim(Ac), 1) = ">" [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Exit[/COLOR] For
                Ac = vbNullString
        [COLOR="Navy"]Next[/COLOR] Ac
               Dn.Offset(, -3) = Mid(Temp, 2)
               Temp = vbNullString
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[CharlesChuckieCharles]

this writes the concatenation to column D
does the entire used range of E

Public Sub JoinCells()
Dim MyRange As Range
Dim MyCell As Range
'MySep = Chr(44) & Chr(34) & Chr(32) & Chr(44)
Set MyRange = Range("E1:E" & Range("E" & Rows.Count).End(xlUp).Row)
For Each MyCell In MyRange
    If MyCell.Value = "" Then
        Exit For
    Else
        MyCell.Offset(, -1).Value = jointhecells(MyCell, 0, True, ", ", ">")
    End If
    
Next MyCell
End Sub

 

[keeblerkev]

MickG,

I noticed one thing with the code. It works great, but it doesn't remove the last cells value (the cell with the ">") in it. Is there a twick to the code to make it clear this cell as well?

Thanks,
Kev

 

[MickG]

Rearrange the order of the lines as below, as shown.

     Temp = Temp & ", " & Ac
      Ac = vbNullString ' This line in now in the middles of the other two.
      If Right(Trim(Ac), 1) = ">" Then Exit For

 

[CharlesChuckieCharles]

You've nullified your =">" test on Ac

 

[MickG]

Well spotted, perhaps this will be better !!!!

[COLOR="Navy"]Sub[/COLOR] MG04Apr07
[COLOR="Navy"]Dim[/COLOR] Temp        [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] RngAc       [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Ac          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("D1"), Range("D" & 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))
         [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Ac [COLOR="Navy"]In[/COLOR] RngAc
                Temp = Temp & ", " & Ac
            [COLOR="Navy"]If[/COLOR] Right(Trim(Ac), 1) = ">" [COLOR="Navy"]Then[/COLOR]
                Ac = vbNullString
                [COLOR="Navy"]Exit[/COLOR] For
            [COLOR="Navy"]Else[/COLOR]
                Ac = vbNullString
            [COLOR="Navy"]End[/COLOR] If
                
        [COLOR="Navy"]Next[/COLOR] Ac
               Dn.Offset(, -3) = Mid(Temp, 2)
               Temp = vbNullString
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[keeblerkev]

Try it, but now it deletes everything in the row instead of stopping. It there a way to maybe do an Ac "including last cell" = vb nullstring?

Thanks!

 

[keeblerkev]

Sorry, didn't see the most recent post! That works!

Thank you MickG and CharlesChuckCharles! This will make things so much easier! Thank you!