Paste append string to cell

[mpo1978]

Hi,

I have written a process that will populate a template sheet with string data data (names) from a source sheet. It works fine. However, there can be more than one name in a target cell. So I'd like the process to append any strings to the cell if it is not empty, separated with a comma and space.

So instead of "ABC" it will read "ABC, DEF".

So I guess I need to add this logic to my code but I'm not sure how:

If the target cell is empty, continue, otherwise append.

Here is my code so far:

Sub ListwithLoop()
'Clears the values out of the target range
Sheets("Pet Eng").Range("PetEngDataClear").ClearContents
'Clears the cell background colour from the target range
Sheets("Pet Eng").Range("PetEngDataClear").Cells.Interior.Pattern = xlNone
Dim counter As Integer
For counter = 1 To 25
'For counter = 1 To Worksheets("R ratings").Range("R:R").Cells.SpecialCells(xlCellTypeConstants).Count
'Only proceed if the Team and Rating columnd are not empty
If Not IsEmpty(Worksheets("R ratings").Range("H1").OFFSET(rowOffset:=counter, columnOffset:=0).Value) Then
If Not IsEmpty(Worksheets("R ratings").Range("R1").OFFSET(rowOffset:=counter, columnOffset:=0).Value) Then
Worksheets("R ratings").Select
Range("A1").OFFSET(rowOffset:=counter, columnOffset:=0).Select
Selection.Copy
Sheets("Pet Eng").Select
Range("E11").OFFSET(rowOffset:=(Worksheets("R ratings").Range("B1").OFFSET(rowOffset:=counter, columnOffset:=0)), columnOffset:=(Worksheets("R ratings").Range("C1").OFFSET(rowOffset:=counter, columnOffset:=0))).PasteSpecial Paste:=xlPasteValues
ActiveCell.Interior.ColorIndex = 4
End If
End If
Next counter
End Sub

Any help would be much appreciated.

Cheers

 

[Fluff]

Not sure if I've understood you correctly, but try this (untested) code

Sub ListwithLoop()
    
    Dim DestRng As Range
    Dim counter As Long
    
    With Worksheets("R ratings")
        'Clears the values out of the target range
        Sheets("Pet Eng").Range("PetEngDataClear").ClearContents
        'Clears the cell background colour from the target range
        Sheets("Pet Eng").Range("PetEngDataClear").Cells.Interior.Pattern = xlNone
        For counter = 1 To 25
            If Not IsEmpty(.Range("H1").Offset(counter).Value) Then
                If Not IsEmpty(.Range("R1").Offset(counter).Value) Then
                    Set DestRng = Sheets("Pet Eng").Range("E11").Offset((.Range("B1").Offset(counter)), (.Range("C1").Offset(counter)))
                    If Len(DestRng.Value) = 0 Then
                        DestRng.Value = .Range("A1").Offset(counter)
                    Else
                        DestRng.Value = DestRng.Value & ", " & .Range("A1").Offset(counter)
                    End If
                    DestRng.Interior.ColorIndex = 4
                End If
            End If
        Next counter
    End With
End Sub

 

[mpo1978]

Fluff - that was exactly what I was after.

Thanks very much!

 

[Fluff]

Glad to help & thanks for the feedback