VBA Concatenate two columns after select case

[ThePangloss]

Hey guys so I have a large set of data. The macro I have right now looks up the name of the person then goes about 15 columns to the right which has people/ gift in the format X / Y, and the column after that has a list of ages Z.
What I need to do is fix up the data so it says X People(Person) / Y Gift(s) / Z, and paste this 20 columns to the right.
Right now I have a macro that does the first part, which is fixing up the data to get X People(Person) / Y Gift(s). Where I'm stuck however is how to concatenate the last column into this data.


[TABLE="width: 500"]
<tbody>[TR]
[TD]Person/Gift[/TD]
[TD]Age[/TD]
[TD]What should be pasted 20 columns to the right[/TD]
[/TR]
[TR]
[TD]3 / 2[/TD]
[TD]35[/TD]
[TD]3 People / 2 Gifts / 35[/TD]
[/TR]
[TR]
[TD]2 / 8[/TD]
[TD]92[/TD]
[TD]2 People / 8 Gifts / 92[/TD]
[/TR]
[TR]
[TD]1 / 4[/TD]
[TD]51[/TD]
[TD]1 Person / 4 Gifts / 51[/TD]
[/TR]
[TR]
[TD]4 / 8[/TD]
[TD]27[/TD]
[TD]4 People / 8 Gifts / 27[/TD]
[/TR]
</tbody>[/TABLE]

[FONT='inherit']Private Sub PGA(colNum As Long, LastRow As Long, foundPass As Range,         List As Range)  
  Dim People As Integer
DimGift As Integer
Dim PeopleRange As String
Dim GiftRange As String
Dim List2 As Range
Dim AgeRange As String
Set foundPass = Rows(2).Find("Name", LookIn:=xlValues, lookat:=xlWhole)colNum = foundPass.ColumnLastRow = Cells(Rows.Count, colNum).End(xlUp).Row
For Each List In Range(Cells(3, colNum + 14), Cells(LastRow, colNum + 14))  
  People = Mid(List.Value, 1, 1)    
Select Case People       
 Case 1        
    PeopleRange = "1 Person"  
      Case 2           
 PeopleRange = "2 People"   
     Case 3       
     PeopleRange = "3 People"  
      Case 4          
  PeopleRange = "4 People"       
 Case 5           
 PeopleRange = "5 People"     
   Case Is >= 6         
   PeopleRange = "6+ People"  
  End Select    
Gift = Mid(List.Value, 5, 1)   
 Select Case Gift    
   Case 1          
  GiftRange = "1 Gift"    
    Case 2         
   GiftRange = "2 Gifts"
        Case 3       
     GiftRange = "3 Gifts"  
      Case 4           
 GiftRange = "4 Gifts"  
      Case 5        
    GiftRange = "5 Gifts"  
      Case Is >= 6       
     GiftRange = "6+ Gifts"
            End Select
    For Each List2 In Range(Cells(3, colNum + 15), Cells(LastRow, colNum + 15)) 
   List2.Value = AgeRange      
  List.Offset(0, 20).Value = PeopleRange & "/" & GiftRange & "/" &     AgeRange 
   Next List2   
 Next List
End Sub[/FONT]

Any ideas would be appreciated. Right now it just goes into like a long loop and ends up pasting the X People / Y Gifts part correctly, but the Z part is only taking the first entry in the column with all the ages, not the specific Z for each row.

 

[WarPigl3t]

Sub myMacro()
     firstRow = 2
     lastRow = Range("A" & Rows.Count).End(xlUp).Row
     r = firstRow
     Do Until r > lastRow
          personGift = Range("A" & r).Value
          age = Range("B" & r).Value
          mySplit = Split(personGift, " / ")
          myConcatenate = mySplit(0)
          If mySplit(0) = 1 Then
               myConcatenate = myConcatenate & " Person"
          Else
               myConcatenate = myConcatenate & " People"
          End If
          myConcatenate = myConcatenate & " /"
          myConcatenate = myConcatenate & mySplit(1)
          If mySplit(1) = 1 Then
               myConcatenate = myConcatenate & " Gift"
          Else
               myConcatenate = myConcatenate & " Gifts"
          End If
          myConcatenate = myConcatenate & " / "
          myConcatenate = myConcatenate & age
          outputColumn = "Z"
          Range(outputColumn & r).Value = myConcatenate
          r = r + 1
     Loop
End Sub