Sub CleanUp()
Application.ScreenUpdating = False
Dim i As Long, j As Long, k As Long
With ActiveSheet
  With .UsedRange
    .Cells.Replace What:=Chr(160), Replacement:="", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    .UnMerge
    .VerticalAlignment = xlCenter
    .WrapText = False
    .HorizontalAlignment = xlLeft
    .Font.ColorIndex = xlAutomatic
    .Font.Underline = False
  End With
  While .Shapes.Count > 0
    .Shapes(1).Delete
  Wend
  .Columns(9).Delete
  .Columns(8).Delete
  .Columns(6).Delete
  .Columns(5).Delete
  .Columns(4).Delete
  .Columns(2).Delete
  For i = 1 To .UsedRange.Rows.Count - 1
    If .Cells(i, 6).Value = "MORTGAGE" Then
      .Cells(i, 5).Value = "MORTGAGE"
      .Cells(i, 6).Value = -(.Cells(i + 1, 6).Value)
    End If
    If Trim(.Cells(i, 2).Value) Like "####-#####" Then
      .Cells(i, 2).Value = Trim(.Cells(i, 2).Value)
      For j = i To .UsedRange.Rows.Count
        If Trim(.Cells(j, 1).Value) <> "" Then Exit For
      Next
      .Cells(i, 9).Value = .Cells(j, 1).Value
      For k = i + 1 To j
        If .Cells(k, 3).Value <> "" Then
          .Cells(i, 3).Value = .Cells(i, 3).Value & " / " & .Cells(k, 3).Value
        End If
      Next
    End If
  Next
  For i = .UsedRange.Rows.Count To 2 Step -1
    If .Cells(i, 2).Value = "" Then .Rows(i).EntireRow.Delete
  Next
  .Columns(1).Delete
  .UsedRange.Rows.AutoFit
  .UsedRange.Columns.AutoFit
End With
Application.ScreenUpdating = True
End Sub