Excel automatically merges cells
I have an Excel spreadsheet with multiple items 1, 2, 3 ... each with sub items 1.1, 1.2, etc. I am using a list of subitems as a key column and populating the main items with vlookups, but only showing each main item once.
/ | A | B | C | - + --------- + ---------- + ---------- + 1 | Item1 | 1.Note | Item1.1 | 2 | | | Item1.2 | 3 | | | Item1.3 | 4 | Item2 | 2.Note | Item2.1 | 5 | | | Item2.2 | 6 | | | Item2.3 | 7 | | | Item2.4 | 8 | Item3 | 3.Note | Item3.1 | 9 | | | Item3.2 | 0 | | | Item3.3 |
Column C is raw data, A and B are formulas.
Column B has notes, so the text can be long. I want to wrap the notes to cover all available rows. I can do this manually by selecting B1: B3 and concatenating them, but then it won't update if I add items to column C. I don't care if the cells are concatenated or just wrapped and overlapped.
Can this be done in formulas or VBA?
Expanding on John Fournier's answer, I modified the range calculation to look for nonblank cells and added code to disable the alert dialog that Merge is calling. I also changed the function to Public so that I can run it from the Macros dialog.
Public Sub AutoMerge()
Dim LastRowToMergeTo As Long
Dim i As Long
Dim LastRow As Long
Application.DisplayAlerts = False
LastRow = Range("S" & CStr(Rows.Count)).End(xlUp).Row
For i = 2 To LastRow
LastRowToMergeTo = i
Do While (Len(Range("D" & CStr(LastRowToMergeTo + 1)).Value) = 0) And (LastRowToMergeTo <> LastRow)
LastRowToMergeTo = LastRowToMergeTo + 1
Loop
With Range("D" & CStr(i) & ":D" & CStr(LastRowToMergeTo))
.Merge
.WrapText = True
.VerticalAlignment = xlVAlignTop
End With
i = LastRowToMergeTo
Next i
Application.DisplayAlerts = True
End Sub
Jon's second part, which has to run the macro on every recalculation, doesn't seem to work, but doesn't matter for the small number of updates I'm doing.
This is possible with VBA, I thought I didn't know if you can do it without VBA. Basically what you do is, every time your worksheet computes, you run the code to re-merge the cells.
I built a simple table similar to yours and put the following code in the worksheet code module:
Private Sub AutoMerge()
Dim LastRowToMergeTo As Long
Dim i As Long
Dim LastRow As Long
LastRow = Range("C" & CStr(Rows.Count)).End(xlUp).Row
For i = 2 To LastRow
LastRowToMergeTo = Range("B" & CStr(i)).End(xlDown).Row - 1
LastRowToMergeTo = Application.WorksheetFunction.Min(LastRowToMergeTo, LastRow)
With Range("B" & CStr(i) & ":B" & CStr(LastRowToMergeTo))
.Merge
.WrapText = True
.VerticalAlignment = xlVAlignTop
End With
i = LastRowToMergeTo
Next i
End Sub
Private Sub Worksheet_Calculate()
AutoMerge
End Sub
source to share