Help modifying a macro

[PrimeTimeAction]

I have a macro (see below) that concatenates selected cells into the upper left cell. The problem is that it keeps the values in rest of selected cell untouched. I want it to either

• delete the text from the rest of the selected cells or
• delete the entire rows of these selected cells.

How can i do this.

Sub Macro1()
Dim r As Range
Dim rr As Range
Dim i As Integer
Dim t As String
i = 0
t = ""
For Each r In Selection
If i = 0 Then
i = 1
Set rr = r
End If
t = t & r.Value
Next
rr.Value = t
End Sub

 

[DanteAmor]

Try this:

Sub macro1a()
    Dim c As Range
    For Each c In Selection.Offset(1, 0)
        Selection.Cells(1, 1).Value = Selection.Cells(1, 1) & c.Value
        c.Value = ""
    Next
End Sub

 

[PrimeTimeAction]

Try this:

Sub macro1a()
    Dim c As Range
    For Each c In Selection.Offset(1, 0)
        Selection.Cells(1, 1).Value = Selection.Cells(1, 1) & c.Value
        c.Value = ""
    Next
End Sub

This works beautifully. thanks alot.
Any idea what to do in case i want to delete the rows of these cells instead of clearing the text?

 

[Fluff]

Just add this to the end of the macro

    Selection.SpecialCells(xlBlanks).EntireRow.Delete

 

[PrimeTimeAction]

Just add this to the end of the macro

    Selection.SpecialCells(xlBlanks).EntireRow.Delete

Thats awesome. Thanks alot. I really appreciate your help.

 

[Fluff]

Glad we could help & thanks for the feedback

 

[DanteAmor]

You're welcome.

 

[PrimeTimeAction]

Glad we could help & thanks for the feedback

You're welcome.

Sorry to bother again. It works great if there is a blank cell below the last cell, but if the the cell below the last cell has and any text, it pulls up that text as well.

Sub macro1()
    Dim c As Range
    For Each c In Selection.Offset(1, 0)
        Selection.Cells(1, 1).Value = Selection.Cells(1, 1) & c.Value
        c.Value = ""
    Next
    Selection.SpecialCells(xlBlanks).EntireRow.Delete
End Sub

 

[Fluff]

Try

Sub macro1()
    Dim c As Range
    With Selection
      For Each c In .Offset(1, 0).Resize(.Rows.Count - 1)
          Selection.Cells(1, 1).Value = Selection.Cells(1, 1) & c.Value
          c.Value = ""
      Next
    End With
    Selection.SpecialCells(xlBlanks).EntireRow.Delete
End Sub

 

[PrimeTimeAction]

Try

Sub macro1()
    Dim c As Range
    With Selection
      For Each c In .Offset(1, 0).Resize(.Rows.Count - 1)
          Selection.Cells(1, 1).Value = Selection.Cells(1, 1) & c.Value
          c.Value = ""
      Next
    End With
    Selection.SpecialCells(xlBlanks).EntireRow.Delete
End Sub

This solved the issue. Thanks alot... again