Push down values in Column if not lowest in row

Location: http://www.mvps.org/dmcritchie/excel/pushdown.htm      
Home page: http://www.mvps.org/dmcritchie/excel/excel.htm
[View without Frames]

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.
 1  2005-03-01  2005-03-02  2005-03-03
 2 apples apples  avocados
 3 bananas  bananas oranges
 4 oranges   peaches
 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.

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
  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
    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)

 1 Bh72 R.sol  A.tum EbN1 N.euro G.metali
 2 PF00013  PF00013 PF00013 PF00013 PF00013  PF00013
 3 PF00015  PF00015 PF00015 PF00015 PF00015  PF00014
 4 PF00023  PF00023 PF00023 PF00023 PF00016  PF00015
 5 PF00027  PF00027 PF00024 PF00027 PF00023  PF00023
 6 PF00028  PF00032 PF00027 PF00032 PF00027  PF00027
 7 PF00032  PF00033 PF00032 PF00033 PF00032  PF00032
 8 PF00033  PF00034 PF00033 PF00034 PF00033  PF00033
 9 PF00034  PF00035 PF00034 PF00035 PF00034  PF00034
10 PF00035  PF00036 PF00035 PF00036 PF00035  PF00035
 1 Bh72 R.sol  A.tum EbN1 N.euro G.metali
 2 PF00013  PF00013 PF00013 PF00013 PF00013  PF00013
 3       PF00014
 4 PF00015  PF00015 PF00015 PF00015 PF00015  PF00015
 5      PF00016 
 6 PF00023  PF00023 PF00023 PF00023 PF00023  PF00023
 7    PF00024   
 8 PF00027  PF00027 PF00027 PF00027 PF00027  PF00027
 9 PF00028      
10 PF00032  PF00032 PF00032 PF00032 PF00032  PF00032
11 PF00033  PF00033 PF00033 PF00033 PF00033  PF00033
12 PF00034  PF00034 PF00034 PF00034 PF00034  PF00034
13 PF00035  PF00035 PF00035 PF00035 PF00035  PF00035
14  PF00036   PF00036  

Excel questions not directly concerning my web pages are best directed to newsgroups
such as news://msnews.microsoft.com/microsoft.public.excel.misc where Excel users all around the clock from at least 6 continents ask and answer Excel questions.  Posting suggestions and netiquette.  More information on newsgroups and searching newsgroups.    Google Groups (Usenet) Advanced Search Excel newsgroups (or search any newsgroup).
This page was introduced on February 09, 2005. 
[My Excel Pages -- home]    [INDEX to my site and the off-site pages I reference] 
[Site Search -- Excel]     [Go Back]    [Return to TOP

Please send your comments concerning this web page to: David McRitchie send email comments

Copyright © 1997 - 2006,  F. David McRitchie,  All Rights Reserved