Excel macro to merge to contents of 4 column into 1 colmun

Hello Experts,

Request a macro that will combine the text in columns A,B,C,& D for each row into a single NEWLY INSERTED column - then delete columns  A,B,C,& D.

Thanks

Norman
gecf343b1Asked:
Who is Participating?
 
DaveCommented:

Sub FellOff()
Dim rng1 As Range
    Set rng1 = Range([a1], Cells(Rows.Count, "D").End(xlUp))
    Columns(5).Insert
    With rng1.Offset(0, 4).Resize(rng1.Rows.Count, 1)
        .FormulaR1C1 = "=RC[-4] &"", "" & RC[-3]&"", "" & RC[-2]&"", "" &RC[-1]"
        .Value = .Value
    End With
    rng1.EntireColumn.Delete
End Sub

Open in new window

0
 
DaveCommented:
hth

Dave

Sub ConandKill()
Dim rng1 As Range
Set rng1 = Range([a1], Cells(Rows.Count, "D").End(xlUp))
With rng1.Offset(0, 4).Resize(rng1.Rows.Count, 1)
.Columns.Insert
.FormulaR1C1 = "=RC[-4]&RC[-3]&RC[-2]&RC[-1]"
.Value = .Value
End With
rng1.EntireColumn.Delete
End Sub

Open in new window

0
 
JeewsCommented:
Try this
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
JeewsCommented:

Dim lnCount As Integer

    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    
    For Each loRow In ActiveWorkbook.Worksheets(1).Rows
    
        If Len(Trim(loRow.Cells(1, 2).Value) & Trim(loRow.Cells(1, 3).Value) & Trim(loRow.Cells(1, 4).Value) & Trim(loRow.Cells(1, 5).Value)) = 0 Then
            lnCount = lnCount + 1
            
            If lnCount > 5 Then
                Exit For
            End If
        Else
            loRow.Cells(1, 1).Value = loRow.Cells(1, 2).Value & loRow.Cells(1, 3).Value & loRow.Cells(1, 4).Value & loRow.Cells(1, 5).Value
            lnCount = 0
        End If
    
    Next
    
    Columns("B:E").Select
    Selection.Delete Shift:=xlToLeft
End Sub

Open in new window

0
 
DaveCommented:
A personal plug maybe but Its much quicker to work with a range object than iterate through a loop

Cheers

DAve
0
 
gecf343b1Author Commented:
Would it possible to separate the text from each column with a comma?
0
 
DaveCommented:
hth

Dave

Dim rng1 As Range
    Set rng1 = Range([a1], Cells(Rows.Count, "D").End(xlUp))
    With rng1.Offset(0, 4).Resize(rng1.Rows.Count, 1)
        .Columns.Insert
        .FormulaR1C1 = "=RC[-4] &"", "" & RC[-3]&"", "" & RC[-2]&"", "" &RC[-1]"
        .Value = .Value
    End With
    rng1.EntireColumn.Delete
End Sub

Open in new window

0
 
gecf343b1Author Commented:
brettdj,

I end up missing data from an adjacent column after running the macro.

0
 
gecf343b1Author Commented:
Jeews,

Your macro works great - would it possible to separate the text from each column with a comma?
0
 
DaveCommented:
I've revised the column insert position accordingly to work with data to the right

Cheers

Dave
0
 
JeewsCommented:
Try This
Sub MergeColumns()
    
Dim lnCount As Integer

    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    
    For Each loRow In ActiveWorkbook.Worksheets(1).Rows
    
        If Len(Trim(loRow.Cells(1, 2).Value) & Trim(loRow.Cells(1, 3).Value) & Trim(loRow.Cells(1, 4).Value) & Trim(loRow.Cells(1, 5).Value)) = 0 Then
            lnCount = lnCount + 1
            
            If lnCount > 5 Then
                Exit For
            End If
        Else
            loRow.Cells(1, 1).Value = loRow.Cells(1, 2).Value & "," & loRow.Cells(1, 3).Value & "," & loRow.Cells(1, 4).Value & "," & loRow.Cells(1, 5).Value
            lnCount = 0
        End If
    
    Next
    
    Columns("B:E").Select
    Selection.Delete Shift:=xlToLeft
End Sub

Open in new window

0
 
gecf343b1Author Commented:
Thanks
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.