Code Not Concatenating Rows in For Each/IF Statmen

Question

I'm trying to concatenate rows that meet a certain condition. When I run the code, the first cell is populated correctly; however, each cell after that is the same as the first cell.

• The first cell is FS_Tier_1 , FS_CAP_1_001
• The next cell should be FS_Tier_1 , FS_CAP_1_002
• The cell after that should be FS_Tier_1 , FS_CAP_1_003, and so on.

However, each cell shows FS_Tier_1 , FS_CAP_1_001. I think it's just a small change I need to make, but I've been blanking on it this afternoon.

I've tried a number of the suggestions on other questions on StackOverflow, as well as playing around with the code myself.

Sub Concatenate_Cap1()

  With Worksheets("PD Code Structure")
      Dim i As Integer
      Dim cell As Range
      Dim Rng1 As Range
      Set Rng1 = Range("F2:F1006")
      i = 2

      For Each cell In Rng1

          If InStr(Cells(i, 3).Value, "FS_Tier_") And InStr(Cells(i, 8).Value, "FS_CAP_1_") Then
              Range("F2:F1006").Formula = Cells(i, 3).Value & " , " & Cells(i, 8).Value
              i = i + 1
          End If

      Next cell
  End With

End Sub

Answer 1

You're setting the whole range to the same value here.

Range("F2:F1006").Formula = Cells(i, 3).Value & " , " & Cells(i, 8).Value

Something like this should work:

Sub Concatenate_Cap1()

    Dim c As Range, rw As range, v3, v8

    For Each c in Worksheets("PD Code Structure").Range("F2:F1006")
        v3 = c.EntireRow.cells(3).value
        v8 = c.EntireRow.cells(8).value
        If InStr(v3, "FS_Tier_") And InStr(v8, "FS_CAP_1_") Then
            c.value = v3 & " , " & v8
        End If
    Next cell

End Sub