Microsoft Office Forums - View Single Post - [Solved] Merging Rows

macropod · 01-14-2015, 01:38 AM

Try the following macro:

Code:

Sub Demo()
Dim lRow As Long, lCol As Long, i As Long, j As Long, SBar As Boolean
With Application
  SBar = .DisplayStatusBar
  .DisplayStatusBar = True
  .ScreenUpdating = False
  .Calculation = xlManual
End With
With ThisWorkbook.Worksheets("AMI_2").UsedRange
  lRow = .Cells.SpecialCells(xlCellTypeLastCell).Row - 1
  lCol = .Cells.SpecialCells(xlCellTypeLastCell).Column
  For i = lRow To 1 Step -1
    Application.StatusBar = "Processing row " & i
    If .Cells(i, 2).Value = .Cells(i + 1, 2).Value Then
      For j = 3 To lCol
        If Len(Trim(.Cells(i, j).Value)) > 0 Then
          .Cells(i + 1, j).Value = .Cells(i, j).Text
          Exit For
        End If
      Next
      .Rows(i).EntireRow.Delete
    End If
  Next
End With
With Application
  .Calculation = xlAutomatic
  .StatusBar = False
  .DisplayStatusBar = SBar
  .ScreenUpdating = True
End With
End Sub

For PC macro installation & usage instructions, see: http://www.gmayor.com/installing_macro.htm. Although the instructions are for Word, the Excel procedure is basically the same. Do note that macros can't be saved in xlsx files - you can run them in an xlsx file, however. If you want to keep the macro in the file for future use, save the file in the xls or xlsm format - or add the macro to your personal.xlsm workbook (see http://www.rondebruin.nl/win/personal.htm).