Excel automatically merge cells

I have an Excel table with several items 1, 2, 3..., each of which has subitems 1.1, 1.2, etc. I'm using the list of subitems as my key column and populating the main items using 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 may be long. I want to wrap the notes to take up all the rows available. I can do this manually by selecting B1:B3 and merging them, but then it won't update if I add items to column C. I don't care if the cells are merged or just wrapped and overlapping.

Can this be done in formulas or VBA?

From stackoverflow

• This is possible using VBA, thought I don't know if you can do it without VBA. Basically what you would do is every time your worksheet calculates you run the code to re-merge the cells.

  I built a simple spreadsheet similar to yours and put the following code in the sheet's 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
  

• Extending Jon Fournier's answer, I've changed the range calculation to look for non-blank cells and added code to turn off the warning dialog that Merge throws up. I also changed the function to Public so I could 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 should run the macro at every recalculate, doesn't seem to work but doesn't matter to me for the small amount of updating I'm doing.