-1

I'm trying to merge cells in excel that are in the same row into 1 cell and then shift the remaining cells to the left.

Example:

Content | Sample | More | More2

So I want to merge "Content" and "Sample" and shift "More" and "More2" cells to the left so the result would be.

Content Sample | More | More2

I found a code that merges the 2 columns but it merges the 2 columns into 1 but it still takes up the second columns. So I have to "Unmerge" and delete the second column and shift "More" and "More2" to the left.

Heres the code that I have:

    Sub MergeOneCell()
    'Updateby20140128
    Dim Rng As Range
    Dim WorkRng As Range
    Dim Sigh As String
    On Error Resume Next
    xTitleId = "KutoolsforExcel"
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
    Sigh = Application.InputBox("Symbol merge", xTitleId, ",", Type:=2)
    xOut = ""
    Application.DisplayAlerts = False
    For Each Rng In WorkRng
    xOut = xOut & Rng.Value & Sigh
    Next
    With WorkRng
    .Merge
    .Value = VBA.Left(xOut, VBA.Len(xOut) - 1)
    End With
    Application.DisplayAlerts = True
    End Sub

Any help would be greatly appreciated. I have a ton of data to process and being able to make this happen would save me hours. I just haven't found any solution so far.

1
  • Why not just concatenate the two cells and then delete.entirecolumn for B? You can do this without VBA Oct 1, 2014 at 17:23

2 Answers 2

1

This takes the inputs and does the operation

Sub test()
Dim str As String
str = Application.InputBox("symbol", "type it", Type:=2)
Dim rng As Range
Set rng = Application.InputBox("Use mouse", "Selection", Type:=8)

For Each c In rng
c.Value = c.Value & str & c.Offset(, 1).Value
Next

rng.Offset(, 1).EntireColumn.Delete

End Sub

Or use a formula like =CONCATENATE(A1,"&",B1) and then manually delete the columns.

0

I didn't want to delete all columns on the right, as there may be values in other rows there. This isn't as concise as above, but works for me...

Sub Concat_Shift_Left()
'
' Concat_Shift_Left Macro
'
' Keyboard Shortcut: Ctrl+Shift+C
'
' This macro will concatenate all cells in a selected range to the first cell,
' separating each cell's value by an input character, and will delete the remaining
' cells on only the first row, by shifting the remaining cells to the left.
' Best to be careful to only select cells on one row, unless you want all other rows loaded in too

Dim i As Integer, left_cell_addr As String, left_cell_val As String

Dim str As String
str = Application.InputBox("separator char", "type it", Type:=2) ' or = " "

Dim rng As Range
Set rng = Selection 'Application.InputBox("Use mouse", "Selection", Type:=8)

left_cell_addr = rng.Cells(1, 1).Address
left_cell_val = " " ' setup a flag for the start of the string

For Each c In rng
  If left_cell_val = " " Then
    left_cell_val = c.Value ' don't load the first char with the plug char
  Else
    left_cell_val = left_cell_val & str & c.Value
  End If
  i = i + 1
Next

Range(left_cell_addr).Value = Trim(left_cell_val)
Range(Range(left_cell_addr).Offset(0, 1).Address, Range(left_cell_addr).Offset(0, 
Application.WorksheetFunction.Min(rng.Columns.Count - 1, i - 1)).Address).Select
Selection.Delete shift:=xlToLeft

End Sub

You must log in to answer this question.

Not the answer you're looking for? Browse other questions tagged .