Push down values in Column if not lowest in row

---

Provide a means to reformat a table such that only the same value is on each row by pushing down values on row that are higher than the lowest non-blank value on a row.

---

A B C  1  2005-03-01  2005-03-02  2005-03-03  2  apples  apples  avocados  3  bananas  bananas  oranges  4  oranges    peaches

A B C  1  2005-03-01  2005-03-02  2005-03-03  2  apples  apples    3      avocados  4  bananas  bananas    5  oranges    oranges  6      peaches

Don't know why this has become such a popular macro, but in order for the macro to function the following things have been included.

• The entire sheet will be processed, except that the first row will be left alone for sorting purposes.
• Each column will be individually sorted.
• Each row will be checked if a value in a column is greater than the lowest value in a that row the column entries will be shiffted down from that point. 
• The checking of values greater than the lowest value will be a text comparison without regard to lettercase -- use of UCASE.
• There is a hard coded 5000 in the macro with regard to the output rows that will be processed, you can change this if the macro is working according to your expectations.
• For testing purposes there is also a macro pushdown_restart to squeeze data again so the pushdown_high can be retested.  It works by identifying empty cells and deleting them with an Shift Up into the deleted cells.

  I have put a limit of 5000 rows in the macro, if you have a possibility of more rows in the final output and have tested the concept you would want to increase this limit (it would increase the running time).

Option Explicit
Sub pushdown_high()
  'David McRitchie,  2005-02-09 rev. 2006-05-23
  Dim r As Long, c As Long, val As String
  Dim xLong as Long
  Dim too_high As String, LastCol As Long
  LastCol = Cells.SpecialCells(xlLastCell).Column
  too_high = application.REPT(CHR(255),20)  'instead of "ZZZZZZZZZZ"
  '--Sort each column starting at row 2 (column has headers)
  For c = 1 To LastCol
    Columns(c).Sort Key1:=Cells(2, c), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  Next c
  For r = 2 To 5000
    val = too_high
    '-- Find lowest value in a row
    For c = 1 To LastCol
       If Trim(Cells(r, c).Value) <> "" And _
           UCase(Cells(r, c).Value) < UCase(val) Then
         val = Cells(r, c).Value
      End If
    Next c

    '-- if not the lowest value in row push down values in column
    For c = 1 To LastCol
      If Trim(Cells(r, c).Value) <> "" And _
             UCase(Cells(r, c).Value) > UCase(val) Then
         Cells(r, c).Insert Shift:=xlDown
      End If
    Next c
    If val = too_high Then GoTo all_done
  Next r
all_done:
  xlong = ActiveSheet.UsedRange.Rows.Count _
        + ActiveSheet.UsedRange.Columns.Count 'Tip73
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub
Sub pushdown_restart()
   ' Select all data, delete empty cells shifting up
   Cells.Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Delete Shift:=xlUp
End Sub
'test data
' Bh72    R.sol   A.tum   EbN1    N.euro  G.metali
'PF00013 PF00013 PF00013 PF00013 PF00013 PF00013
'PF00015 PF00015 PF00015 PF00015 PF00015 PF00014
'PF00023 PF00023 PF00023 PF00023 PF00016 PF00015
'PF00027 PF00027 PF00024 PF00027 PF00023 PF00023
'PF00028 PF00032 PF00027 PF00032 PF00027 PF00027
'PF00032 PF00033 PF00032 PF00033 PF00032 PF00032
'PF00033 PF00034 PF00033 PF00034 PF00033 PF00033
'PF00034 PF00035 PF00034 PF00035 PF00034 PF00034
'PF00035 PF00036 PF00035 PF00036 PF00035 PF00035

Copying data from web pages (#webdata)

Important Note:  When copying data from a web page such as from the table below you will have formatting characters such as non breaking spaces, CHAR(160), and others such as TAB, CR, LF charactes that you do not want in your data.  You may at times also have to use Data, Text to Columns to get things into proper columns.  When copying data from a web page get in the habit of running the TRIMALL macro as found in http://www.mvps.org/dmcritchie/excel/join.htm#trimall and where you will find additional information.

Example   (#example)