Private Function col_num(find_text As String, wrk_sht As Worksheet, Optional row_num As Long = 1) As Integer
If row_num < 1 Or row_num > wrk_sht.Rows.Count Then Exit Function
Dim top_row As Range
Dim rng As Range
With wrk_sht
On Error Resume Next
Set top_row = Intersect(.Rows(row_num).Cells, .UsedRange)
On Error GoTo 0
End With
If top_row Is Nothing Then Exit Function
find_text = LCase(Trim(find_text))
For Each rng In top_row
If LCase(Trim(rng.Value)) Like "*" & find_text & "*" Then
col_num = rng.Column
Exit Function
End If
Next rng
End Function
Sub Concatenate_Text()
Dim col1 As Integer
Dim col2 As Integer
Dim lrow As Long
Dim lcol As Integer
Dim i As Long
Dim j As Integer
col1 = col_num("address1", ActiveSheet)
col2 = col_num("telephone", ActiveSheet)
With ActiveSheet
lrow = .Cells(.Rows.Count, "A").End(xlUp).Row
lcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
ActiveSheet.Cells(1, lcol + 1).Value = "Contact Details"
For i = 2 To lrow
For j = col1 To col2
With ActiveSheet.Cells(i, lcol + 1)
.Value = Trim(.Value & Space(1) & ActiveSheet.Cells(i, j).Value)
End With
Next j
Next i
End Sub
