Dynamic Concatination Macro

[capson]

Hello,

I need to concantenate anywhere from two to N cells per row where N is the number of headers in an Array I populate.

Also the columns per project move about so I need to use header names instead of Column Numbers.

Also I am using Arrays becuse I can have upword of 400,000 rows and need the macro to be speedy

I got this far in that I can hard code the concatination using header names but I can not figure out how to make it dynamic so as to not hard code the a1, a2, a3,..., an and myresult

Thank you

Sub Concat()
Dim myresult, hNum
Dim a1 As Variant, a2 As Variant, a3 As Variant, a4 As Variant, HN As Variant
Dim wsS As Worksheet, wsPB As Worksheet
Dim  i As Long, j As Long

HN = Array("Age", "Gender Identity", "Ethnicity1", "Ethnicity2")

 Set wsS = ThisWorkbook.Sheets("ElementsFile")
Set wsPB = ThisWorkbook.Sheets("ElementsFile")

ReDim hNum(0 To UBound(HN))
With wsS
     aLR = .Range("A" & .Rows.Count).End(xlUp).Row
    For i = 0 To UBound(HN)
         j = wsS.Rows(1).Find(HN(i)).Column
         hNum(i) = j
     Next i
End With

With wsS
a1 = .Range(Cells(2, hNum(0)), Cells(aLR, hNum(0)))
a2 = .Range(Cells(2, hNum(1)), Cells(aLR, hNum(1)))
a3 = .Range(Cells(2, hNum(2)), Cells(aLR, hNum(2)))
a4 = .Range(Cells(2, hNum(3)), Cells(aLR, hNum(3)))
End With

ReDim myresult(1 To UBound(a1), 1 To UBound(a1))

For i = 1 To UBound(a1)
   If Not (IsEmpty(Cells(i, hNum(0))) And IsEmpty(Cells(i, hNum(1)))) Then
     myresult(i, 1) = Cells(i, hNum(0)) & "|" & Cells(i, hNum(1)) & "|" & Cells(i, hNum(2)) & "|" & Cells(i, hNum(3))
   Else
     myresult(i, 1) = vbNullString
   End If
Next i

  wsPB.Range("D1").Resize(UBound(a1, 1), 1) = myresult

End Sub