Macro to merge cells

[dment]

Hi

I a trying to create a macro that will merge a number of cells in a column based on a value in another cell

the spreadsheet is laid out

Column A Column B Column C Column D Column E

City ProductID Cost Total Amount Count
London 001 £1.00 £7.00 5
London 002 £2.00
London 008 £8.00
London 004 £4.00
London 002 £2.00
Birmingham 003 £3.00 £20.00 5
Birmingham 005 £5.00
Birmingham 004 £4.00
Birmingham 005 £5.00
Birmingham 003 £3.00
Manchester 001 £1.00 £16.00 6
Manchester 002 £2.00
Manchester 004 £4.00
Manchester 001 £1.00
Manchester 005 £5.00
Manchester 003 £3.00

I need to merge column D for each city.
I had a macro that used xlDown but this takes it down to the bottom of the workbook rather than the next cell which has a figure in (This is due to the spreadsheet having a formula in the cells) so I think I will need to use the count figure in column E

Any help will be much appreciated.

 

[dment]

In column E do you also have formulas?

Do you want to keep the formula in column D, in this case on the merged cell?

Try this:

Sub merge_cells2()
  Dim ant As Variant, i As Long, ini As Long
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  ini = 2
  ant = Range("A2").Value
  For i = 2 To Range("A" & Rows.Count).End(xlUp).Row + 1
    If ant <> Cells(i, "A").Value Then
      With Range("D" & ini & ":D" & i - 1)
        .MergeCells = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
      End With
      ini = i
    End If
    ant = Cells(i, "A").Value
  Next
End Sub

This worked perfectly Many thanks for all your hep

 

[DanteAmor]

This worked perfectly Many thanks for all your hep

Hi @dment, I'm glad to help you. Thanks for the feedback.