concatenating cell ranges

[fredd2]

Hi
I have a spreadsheet with individual headings, and cell data in those columns that can either be 1, 2 or 3. I need to add a column that, for example, looks at each cell in row 2 and concatenates the column heading for each cell which has a value of 2. This would then give me a list in the first cell in row 2 of all the columns meeting that criteria.

An example would be:

Names / Result column / module a / module b / module c
Tom / module b / 1 / 2 / 3
Dick / module a; module b /2 / 2 / 3
Harry / / 1 / / 1

I'm sorry if the layout isn't totally clear, but I can't get the tabs to stay in place after I click the next button.
I can do a basic concatenate by using =concatenate(=if(b1=1,a1&2", ",null,etc but this only works until the limit on the number of characters in the formula is reached.

I have found code on the internet which concatenates ranges. However, I can't find a way to select only certain values from that range, or to show the column headings instead of the value of the cells themselves.

The code I have found is:

Function concatenaterangemedium(Parts As Range, Separator As String)
Dim strTemp, sepTemp As String
Dim cel As Range
Dim toprow As Range
Dim cnt As Integer
strTemp = ""
For Each cel In Parts.Cells
If cel.Value = "" Or cel.Value = 0 Then
sepTemp = ""
Else
sepTemp = Separator
End If
strTemp = strTemp & sepTemp & cel.Value
Next cel
concatenaterangemedium = strTemp
End Function

What it does is concatenate a range of cell data in a row, and puts separators between each cell value.

What I would like it to do is only concatenate the cell values if they are a certain value. For example, only concatenate for cells with the value of 2. When I have tried amending the code I've ended up with all the values in, but the separator missed out after the value 2, which is totally wrong.

Thank you.

 

[SkipVought]

Fred,

Soemthing like this might work for you...

Sub test()
    Dim r As Range, rng As Range
    
    For Each r In Range([A2], [A2].End(xlDown))
        With Cells(r.Row, "B")
            For Each rng In Range(Cells(r.Row, "C"), Cells(r.Row, "C").End(xlToRight))
                If rng.Value = 2 Then
                    .Value = .Value & Cells(1, rng.Column).Value & ";"
                End If
            Next
            If Trim(.Value) <> "" Then _
                .Value = Left(.Value, Len(.Value) - 1)
        End With
    Next
End Sub

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

sorry, this one accounts for empty cells...

Sub test()
    Dim r As Range, rng As Range
    
    For Each r In Range([A2], [A2].End(xlDown))
        With Cells(r.Row, "B")
            For Each rng In Range(Cells(r.Row, "C"), Cells(r.Row, ActiveSheet.UsedRange.Columns.Count).End(xlToRight))
                If rng.Value = 2 Then
                    .Value = .Value & Cells(1, rng.Column).Value & ";"
                End If
            Next
            If Trim(.Value) <> "" Then _
                .Value = Left(.Value, Len(.Value) - 1)
        End With
    Next
End Sub

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

how sloppy of me...

Sub test()
    Dim r As Range, rng As Range
    
    For Each r In Range([A2], [A2].End(xlDown))
        With Cells(r.Row, "B")
            For Each rng In Range(Cells(r.Row, "C"), Cells(r.Row, ActiveSheet.UsedRange.Columns.Count))
                If rng.Value = 2 Then
                    .Value = .Value & Cells(1, rng.Column).Value & ";"
                End If
            Next
            If Not Trim(.Value) = "" Then _
                .Value = Left(.Value, Len(.Value) - 1)
        End With
    Next
End Sub

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

Here it is as a function...

Function ModulesWithVal(rng As Range, val As Integer, sep As String)
    Dim r As Range
    For Each r In rng
        If r.Value = val Then
            ModulesWithVal = ModulesWithVal & Cells(1, r.Column).Value & sep
        End If
    Next
    If Not Trim(ModulesWithVal) = "" Then _
        ModulesWithVal = Left(ModulesWithVal, Len(ModulesWithVal) - 1)
End Function

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[fredd2]

That is exactly what I needed. Thank you very much.