Excel 2013 VBA loop: How to add to text in cell

[jedwardo]

Hi Everyone,

I have this loop I'm building and there's one part (highlighted blue) where it takes all cells with the color index of 46 and places their values in this cell Sheets(1).Cells(2, 81).Value. At the moment each one overwrites the previous. What I'm looking for is for the text to accumulate in that cell separated by a comma for each new addition

Sub TestCode()
Dim iCell As Range, ws As Worksheet
Set ws = Sheet6
Lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
    For Each iCell In Range("A2:CA30")
        With iCell
        If iCell.Interior.ColorIndex = 35 Then
            ws.Cells(Lastrow + 1, 1).Value = iCell.Value
            ws.Cells(Lastrow + 1, 1).Offset(0, 1).Value = iCell.Offset(0, 1).Value
            Lastrow = Lastrow + 1
        ElseIf iCell.Value <> "" And iCell.Interior.ColorIndex = 3 Then
            ws.Cells(Lastrow + 1, 3).Value = Sheets(1).Cells(1, iCell.Column).Value
            ws.Cells(Lastrow + 1, 10).Value = iCell.Value
            Lastrow = Lastrow + 1
        ElseIf iCell.Value <> "" And iCell.Interior.ColorIndex = 24 Then
            ws.Cells(Lastrow + 1, 3).Value = Sheets(1).Cells(1, iCell.Column).Value
            ws.Cells(Lastrow + 1, 6).Value = iCell.Value
            ws.Cells(Lastrow + 1, 8).Value = iCell.Offset(0, 1).Value
            Lastrow = Lastrow + 1
        ElseIf iCell.Value > "0" And iCell.Interior.ColorIndex = 40 Then
            ws.Cells(Lastrow + 1, 8).Value = Sheets(1).Cells(1, iCell.Column).Value
            ws.Cells(Lastrow + 1, 10).Value = iCell.Value
            Lastrow = Lastrow + 1
[COLOR=#0000ff]        ElseIf iCell.Value > "0" And iCell.Interior.ColorIndex = 46 Then[/COLOR]
[COLOR=#0000ff]            Sheets(1).Cells(2, 81).Value = Sheets(1).Cells(1, iCell.Column).Value[/COLOR]
        ElseIf iCell.Value > "0" And iCell.Interior.ColorIndex = 48 Then
            ws.Cells(Lastrow + 1, 8).Value = Sheets(1).Cells(1, iCell.Column).Value
            ws.Cells(Lastrow + 1, 10).Value = iCell.Offset(0, 1).Value
            Lastrow = Lastrow + 1
        End If[COLOR=#00ffff][/COLOR][COLOR=#40e0d0][/COLOR]
        End With
    Next iCell
End Sub

Thanks,
Jordan

 

[blaow]

You can concatenate text in vb using the & operator.

To add in commas, do something like this:

Sheets(1).Cells(2,81).Value = Sheets(1).Cells(2,81).Value & ", " & string2

etc.

 

[VoG]

Maybe

Sheets(1).Cells(2, 81).Value = Sheets(1).Cells(2, 81).Value & "," & Sheets(1).Cells(1, iCell.Column).Value

 

[Snakehips]

Jordan,

Try replacing with....

ElseIf iCell.Value > "0" And iCell.Interior.ColorIndex = 46 Then
If Sheets(1).Cells(2, 81).Value = "" Then
    Sheets(1).Cells(2, 81).Value = Sheets(1).Cells(1, iCell.Column).Value
    Else
    Sheets(1).Cells(2, 81).Value = Sheets(1).Cells(2, 81).Value & "," & Sheets(1).Cells(1, iCell.Column).Value
End If

Hope that helps.

 

[jedwardo]

Wow, you guys are great thanks. I feel stupid though I didn't foresee something obvious. Using the last code from snakehips the appropriate cells ended up in the designated area but then all other values from the other rows were appended as well. Is it possible to make the target destination go down the column one row as the loop goes through the rows?

[/IMG]

So in this example BE2 and BF2's header values would get transfered to CC2 like the code told them to but then in the next row BE3 would go to CC3, BE4 to CC4 and so on.

 

[jedwardo]

Nevermind I figured that part out. Changed the cell 2 in the code to iCell.row. Thanks again everyone

If Sheets(1).Cells([COLOR=#0000ff]iCell.Row[/COLOR], 81).Value = "" Then                
                Sheets(1).Cells([COLOR=#0000ff]iCell.Row[/COLOR], 81).Value = Sheets(1).Cells(1, iCell.Column).Value
                Else
                Sheets(1).Cells([COLOR=#0000ff]iCell.Row[/COLOR], 81).Value = Sheets(1).Cells([COLOR=#0000ff]iCell.Row[/COLOR], 81).Value & "," & Sheets(1).Cells(1, iCell.Column).Value
                Lastrow = Lastrow + 1

 

[blaow]

Try referencing the row like this:

ElseIf iCell.Value > "0" And iCell.Interior.ColorIndex = 46 Then
If Sheets(1).Cells(iCell.Row, 81).Value = "" Then
Sheets(1).Cells(iCell.Row, 81).Value = Sheets(1).Cells(1, iCell.Column).Value
Else
Sheets(1).Cells(iCell.Row, 81).Value = Sheets(1).Cells(iCell.Row, 81).Value & "," & Sheets(1).Cells(1, iCell.Column).Value
End If


THIS CODE HAS NOT BEEN TESTED, BACKUP YOUR DATA

 

[blaow]

You beat me too it, nice work on figuring it out on your own. That's the feeling that makes it all worth it