Excel VBA Macro to concatinate two columns using column header id name - vba

Question

I am really new in writing Excel macros through VBA. I want to concatenate two columns in my Excel worksheet. I have data in columns A, B & C and I want to concatenate B & C column to D column. This is the code I wrote:
Sub FINAL()
'
' FINAL Macro
'
'
Columns("D:D").Select
Selection.Insert Shift:=xlToRight
Range("D2").Select
ActiveCell.FormulaR1C1 = "SO::LI"
Range("D3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=RC[-2]&""::""&RC[-1]"
Range("D3").Select
Dim lastRow As Long
lastRow = Range("C" & Rows.Count).End(xlUp).Row
Range("D3").AutoFill Destination:=Range("D3:D" & lastRow)
End Sub
This works fine. But This works only when my data is in columns A, B & C.
When the data is in different columns, such as E, F & G, this does not work.
So what I want is to find the column using column header name and concatenate data.
Style S/O L/I
392389 265146 40
558570 300285 10
558570 300285 20
After concatenation:
Style S/O L/I SO::LI
392389 265146 40 265146::40
558570 300285 10 300285::10
558570 300285 20 300285::20

Answer 1

You can find a column header by using the worksheet MATCH function inside VBA, here I'll put it in to a variable called c1
c1 = Application.WorksheetFunction.Match("S/O", Range("1:1"), 0)
It's best to wrap this identification in a potential error handler, because if there IS no match then you'll get a run-time error
If Application.WorksheetFunction.CountIf(Range("1:1"), "S/O") > 0 Then
c1 = Application.WorksheetFunction.Match("S/O", Range("1:1"), 0)
Else
MsgBox ("Couldn't find ""S/O"" header!")
Exit Sub
End If
Here it uses the worksheet function COUNTIF to make sure there is at least one instance of "S/O" - if there isn't then the subroutine ends.
After that, you've identified your S/O column so can carry on with the rest of the code as usual - if you assume the columns are always consecutive then you can use c1 + 1 to mean "L/I" column and c1 + 2 to mean the CONCAT column
Below is a fully working version of the code:
Private Sub CommandButton1_Click()
Dim c1 As Long
Dim lastRow As Long
' If instance of "S/O" exists then find the column number else show error message and end
If Application.WorksheetFunction.CountIf(Range("1:1"), "S/O") > 0 Then
c1 = Application.WorksheetFunction.Match("S/O", Range("1:1"), 0)
Else
MsgBox ("Couldn't find ""S/O"" header!")
Exit Sub
End If
' Get last row for formula based on the "S/O" column header in c1
lastRow = Cells(Rows.Count, c1).End(xlUp).Row
' add 2 to c1 to make the c1 variable contain column number for SO::LI
c1 = c1 + 2
' use FormulaR1C1 as usual to flood the whole column from row 2 to lastRow
Range(Cells(2, c1).Address, Cells(lastRow, c1).Address).FormulaR1C1 = "=RC[-2]&""::""&RC[-1]"
End Sub

Answer 2

You may give this a try...
The code will find the headers in row2 and concatenate the columns.
Sub Final()
Dim FirstCell As Range, SecondCell As Range
Dim lr As Long, r As Long, c As Long
Application.ScreenUpdating = False
'Assuming that the Row2 is the Header Row, if not change it.
Set FirstCell = Rows(2).Find("S/O")
If FirstCell Is Nothing Then
MsgBox "A column with the header S/O was not found.", vbExclamation
Exit Sub
End If
Set SecondCell = Rows(2).Find("L/I")
If SecondCell Is Nothing Then
MsgBox "A column with the header L/I was not found.", vbExclamation
Exit Sub
End If
r = FirstCell.Row + 1
c = SecondCell.Column + 1
Set FirstCell = FirstCell.Offset(1)
Set SecondCell = SecondCell.Offset(1)
lr = Cells(Rows.Count, SecondCell.Column).End(xlUp).Row
Columns(c).Insert
Range(Cells(r, c), Cells(lr, c)).Formula = "=" & FirstCell.Address(0, 0) & "&""::""&" & SecondCell.Address(0, 0) & ""
Application.ScreenUpdating = True
End Sub

Answer 3

Use FormulaR1C1 instead is useful
Sub mergeColumn()
Dim col As Integer
Dim tr As Long
Application.ScreenUpdating = False
On Error Resume Next
col = Rows(1).Find(What:="S/O").Column
On Error GoTo 0
If col <> 0 Then ' if not found, it goes to 0
tr = Cells(Rows.Count, col).End(xlUp).Row
Range(Cells(1, col + 2), Cells(tr, col + 2)).Value = "=RC[-2] & ""::"" & RC[-1]"
End If
Application.ScreenUpdating = True
End Sub