Insert a Row using a Macro to maintain formulas

Location:   http://www.mvps.org/dmcritchie/excel/insrtrow.htm
               Code:   http://www.mvps.org/dmcritchie/excel/code/insrtrow.txt
Home page: http://www.mvps.org/dmcritchie/excel/excel.htm
[View without Frames]

 

[offset], [insrtrow] [dclick], [copyformulas], [InsertBlankRows], [moreresize], [ChangeEvent], [extended], [AltBlanks], [ColAchg], [before_a], [reconcile], [ManualInsert], [DeleteK], [DeleteR], [addendum], [sign_onright], [fixrightminus], [clearCols], [extraTotals], [blankrows], [multilabel], [#VALUE!], [carrybalance], [related],

This page contains some VBA macros.  If you need assistance to install or to use a macro please refer refer to my  Getting Started with Macros  page.  Standard macro can be invoked from any worksheet.
This page also contains Worksheet EVENT macros, which are installed differently.  Worksheet event macros are designed for a specific worksheet and only apply to the worksheet they are installed into.  Examples change event, double-click, cell change, right-click.


The macro InsertRowsAndFillFormulas() had a major update on 2000-09-02
INSRTROW is a macro to copy the selected line making the requested number of copies of it downward, but to include only the formulas.  Leaving the constants to be manually filled in.  (button *)

I wanted to be able to insert a row and maintain the formulas but not to copy data that would be unique for the line.  The propagation of data would be misleading so I want it to be blank so I have to enter it myself.

See also use of OFFSET in formulas which simplifies the insertion, and deletion of rows with the InsertRowsAndFillFormulas macro and allows you to sort the rows; whereas, sorting rows containing simple addition and subtraction of relative addresses would make a mess.
 

 ABC DEFGHI
1 DateCheck#DescriptionsDR    CRBalanceReconciledstmt
2301/20/1998DEPInitial Balance2000.00 2000.0002/27/982000.00
3602/06/1998DebitPhone Co. 18.221981.7802/27/981981.78
4202/23/19982619Gas/Electricity 117.971863.81 1981.78

Want to insert a line so select row 2 or any cell on row 2 such as D2, then hit the macro button to invoke InsertRowsAndFillFormulas.
 

 ABC DEFGHI
1 DateCheck#DescriptionsDR    CRBalanceReconciledstmt
2301/20/1998DEPInitial Balance2000.00 2000.0002/27/982000.00
37       2000.00  2000.00
4602/06/1998DebitPhone Co. 18.221981.7802/27/981981.78
5202/23/19982619Gas/Electricity 117.971863.81 1981.78

The formulas have been copied but cells that do not contain formulas are empty, and the data can now be entered with the results as follows:

 

 ABC DEFGHI
1 DateCheck#DescriptionsDR    CRBalanceReconciledstmt
2301/20/1998DEPInitial Balance2000.00 2000.0002/27/982000.00
3502/05/19982618Subscription 26.951973.05  1981.78
4602/06/1998DebitPhone Co. 18.221954.8302/27/981981.78
5202/23/19982619Gas/Electricity 117.971836.86 1981.78

Normally the dates in Column B are entered using the shortcut key for the current date [Ctrl+semi-colon].
When using a Debit card enter a letter instead of the date into the reconciled column.  Change the letter to an actual date when you have banks entry.

My DR/CR are the opposite of what most US checkbooks show, since I prefer to keep records for myself and not for my bank or their point of view.  At one time you could ask the bank to provide with with a properly labelled checkbook, but now you would probably have toe chenage the titles yourself.  You can see a representation of what your checkbook and a bank statement might look like -- Pain-free Bank Reconciliations - MyWebCA, by David Trahair, C.A., it is a Canadian site, but that was the easiest for me to find).

¤ If you maintain a checkbook in Excel you can add up deposits for a deposit slip by selecting the range and looking at the SUM= on the status bar.

The lazy way of keeping your bank balances is to use Quicken (or MS Money) and download records from you financial institutions.  Unfortunately you would not see both dates -- the date on your check and the date it cleared.

Why must we use that funny looking OFFSET Worksheet Function (#offset)

OFFSET(reference, rows, cols, height, width)

In order to use the InsertRowsAndFillFormulas macro, the formulas must be entered naming only the cellnames found on the current row.  By referencing cells in the current row any insertion or deletion of lines will cause formulas to be updated.  In order to refer to cells elsewhere but to name only cell addresses in the current row, OFFSET will be used as follows:

A3    =IF(B3="",">",WEEKDAY(B3,1))
  
G3=OFFSET(G3,-1,0)+E3-F3
 instead of
 =G2+E3-F3
  
 Optionally assume 5 days to clear
H3=IF(NOW()>B3+5,"*","")
 Fill in a real date when you have it
  
I3=IF(H3<>"",OFFSET(I3,-1,0)+E3-F3,OFFSET(I3,-1,0))
 instead of
 =IF(H3<>"",I2+E3-F3,I2)
  
 Optionally include a low balance warning in RED
J3=IF(OR(G3<250,I3<300),"XX",""),"")

Replication is made easier by grabbing and dragging the fill handles and with the use of shortcuts Ctrl+D (Fill Down), and Ctrl+R (Fill Right).  OFFSET makes Replication/Deletion of Rows tie in better with the other rows, and of course, makes possible the InsertRowsAndFillFormulas macro described in the next topic.

A more explicit example of OFFSET and using the macro described below can be found in Using OFFSET to maintain formulas also includes use of INDEX in totals and subtotals to add up to the row above without regard to typing in any specific cell address as in  =SUM(A2:INDEX(A:A,ROW()-1))  instead of  =SUM(A2:OFFSET(A300,-1,0)  in cell A300.

Code for the InsertRowsAndFillFormulas Macro (#insrtrow)

To obtain a macro that would do what I wanted I posted to the newsgroup what I wanted and failed at that.  I then found and included a macro close to what I wanted and described again exactly what I really needed.  This worked very well and the solution involved a one line addition that removed non formulas from the inserted line providing exactly what I wanted. 

insrtrow The primary macro InsertRowsAndFillFormulas is installed on a toolbar button*

Both macros are installed on a module sheet in my personal.xls   The code below has extra blank lines to help identify long lines it they get wrapped when you copy them.  For more information on why INTERSECT and how SpecialCells are used in the following macros see comments with Proper_Case macro.  The following macro pair is the main focus of this web page; however, there is also a Change event macro that may be of interest (further down).

 
Sub InsertRowsAndFillFormulas_caller()
  '-- this macro shows on Tools, Macro..., Macros (Alt+F8) dialog 
  Call InsertRowsAndFillFormulas
End Sub
 
Sub InsertRowsAndFillFormulas(Optional vRows As Long = 0)
' Documented:  http://www.mvps.org/dmcritchie/excel/insrtrow.htm
' Re: Insert Rows --   1997/09/24 Mark Hill <markhill@charm.net.noSpam>
   ' row selection based on active cell -- rev. 2000-09-02 David McRitchie
   Dim x as long 
   ActiveCell.EntireRow.Select  'So you do not have to preselect entire row
   If vRows = 0 Then
    vRows = Application.InputBox(prompt:= _
      "How many rows do you want to add?", Title:="Add Rows", _
      Default:=1, Type:=1) 'Default for 1 row, type 1 is number
    If vRows = False Then Exit Sub
   End If

   'if you just want to add cells and not entire rows
   'then delete ".EntireRow" in the following line

   'rev. 2001-01-17 Gary L. Brown, programming, Grouped sheets
   Dim sht As Worksheet, shts() As String, i As Long
   ReDim shts(1 To Worksheets.Application.ActiveWorkbook. _
       Windows(1).SelectedSheets.Count)
   i = 0
   For Each sht In _
       Application.ActiveWorkbook.Windows(1).SelectedSheets
    Sheets(sht.Name).Select
    i = i + 1
    shts(i) = sht.Name

    x = Sheets(sht.name).UsedRange.Rows.Count 'lastcell fixup

    Selection.Resize(rowsize:=2).Rows(2).EntireRow. _
     Resize(rowsize:=vRows).Insert Shift:=xlDown

    Selection.AutoFill Selection.Resize( _
     rowsize:=vRows + 1), xlFillDefault

    On Error Resume Next    'to handle no constants in range -- John McKee 2000/02/01
    ' to remove the non-formulas -- 1998/03/11 Bill Manville
    Selection.Offset(1).Resize(vRows).EntireRow. _
     SpecialCells(xlConstants).ClearContents
   Next sht
   Worksheets(shts).Select
End Sub
Note that there is an optional parameter that can be used from another macro.  It would be best to keep the macro as is for general use, but when calling from a macro to have the calling macro include the number of rows to be inserted and no MsgBox.

Invoking the macro

Select the row above where you want to insert the rows, this is also the row whose formulas will be copied down.

The first time you test you would probably invoke the macro ... from Tools, Macros, macros (Alt+F8) choosing ...

For easier use in invoking the InsertRowsAndFillFormulas macro, I use a toolbar button [Insert Row] — A display of my custom buttons can be seen on that page.


The main article on this page, InsertRowsAndFillFormulas Macro, is above, the rest of the material deals with specialized implementations of the above or specialized macros that provide similar function.

Double click event macro to invoke InsertRowsAndFillFormulas (#dclick)

The following is an Event Macro, and will insert 3 rows without prompting, this one is triggered by a Double Click. (see next two topics about installaton of an Event macro)
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   Cancel = True   'Get out of edit mode 
   Application.Run "personal.xls!InsertRowsAndFillFormulas", 3
End Sub

Clear Constants   (#clear_constants)

The following macro will clear the constants from selection area(s).  You can install it in a toolbar menu, a toolbar button, or a right-click menu.  The code for this macro will be with the code associated with rightclick page, but the coding below is relevant to material on the page you are currently viewing, as it is the same as the primary feature in insert rows and retain formulas.
Sub Clear_Constants()     'D.McRitchie 2005-11-19 rightclick.htm - insrtrow.htm
   '-- provide for in rightclick  cell, row, and column commandbars
   Dim rng As Range  'prevent expansion of a single cell selection
   Set rng = Intersect(Selection, Selection.SpecialCells(xlConstants), ActiveSheet.UsedRange)
   If rng Is Nothing Then
     MsgBox "No constants in selection area(s) -- no removal"
   Else
     rng.ClearContents
   End If
End Sub
To manually remove constants from a selection, see later topic -- Manually removing constnts from a selection.

Event Macros to Insert Rows or Populate Content (#event_maros)

Event macros are installed differently that standard macros.  Each of the Event macros below are Worksheet Event Macros and can be installed by right clicking on the worksheet tab then View Code, then insert the event macro.  More information on Event macros.

Double Click to insert row below and propogate formulas (#event_dclick)

Example of an Event Macro that simply inserts a row below the current row, and populates it with the formulas, by copying and wiping out the constants.  (#dclick)
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   Cancel = True   'Eliminate Edit status due to doubleclick
    Target.Offset(1).EntireRow.Insert
    Target.EntireRow.Copy target.Offset(1).EntireRow
    on error resume next
    Target.Offset(1).EntireRow.SpecialCells(xlConstants).ClearContents
    on error goto 0
End Sub
Same example but insert 3 rows copying formulas
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   Cancel = True   'Eliminate Edit status due to doubleclick
    target.Offset(1).EntireRow.Resize(3).Insert
    target.EntireRow.Copy target.EntireRow.Offset(1).Resize(3).EntireRow
    on error resume next
    target.Offset(1).EntireRow.Resize(3).SpecialCells(xlConstants).ClearContents
    on error goto 0
End Sub
The following Worksheet DoubleClick Event Macro will copy formulas down from the last row, and increment the value in Column A of the last row by 7 days for the new row then place the cursor in the first empty cell of the new row.  The last row is determined by having content in Column A.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim lastrow As Long   'D.McRitchie,  2004-06-10, newusers
  lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
  Rows(lastrow).AutoFill Rows(lastrow).Resize(2), xlFillDefault
  on error resume next
  Rows(lastrow + 1).SpecialCells(xlConstants).ClearContents
  on error goto 0
  Cells(lastrow + 1, 1) = Cells(lastrow, 1) + 7
  Rows(lastrow + 1).SpecialCells(xlCellTypeBlanks).Item(1).Activate
End Sub
This example will insert a row below the cell double-clicked on, copying the formulas from the row double-clicked on into the inserted row, then will remove constants from the inserted row based on the intersection range specified.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  'David McRitchie,  2007-09-07    insrtrow.htm on double-click
  '-- will copy more often than  Extend Formulas and Format (tools option)
  Cancel = True
  Target.EntireRow.Copy
  Cells(Target.Row + 1, 1).EntireRow.Insert
  Cells(Target.Row + 1, 1).EntireRow.Select
  ActiveSheet.Paste
  Application.CutCopyMode = False
  On Error Resume Next
  '-- customize range for what cells constants can be removed --
  Intersect(Selection, Range("b:IV")).SpecialCells(xlConstants).ClearContents
  On Error GoTo 0
End Sub
Example of an Event Selection Macro (#copyformulas).  that will copy formulas from the preceding row when the cell in Column A is selected and there is no content below in column A and no previous content on the row.  Extend Formats and Formulas can be fussy, this will trigger on the above conditions copying all formatting, and removing constants after copying the row above.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  'David McRitchie,  2004-06-02
  '-- will copy more often than  Extend Formulas and Format (tools option)
  Dim lastrow As Long
  If Target.Column <> 1 Then Exit Sub
  If Target.Row < 2 Then Exit Sub
  If Not IsEmpty(Target) Then Exit Sub    'cell must be empty
  lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
  If Target.Row <> lastrow + 1 Then Exit Sub  'Row must be empty
    
  Rows(Target.Row - 1).Copy
  ActiveSheet.Paste
  Application.CutCopyMode = False
  on error resume next
  Target.EntireRow.SpecialCells(xlConstants).ClearContents
  Application.EnableEvents = False   'should be part of Change macro
  Target.Select
  Application.EnableEvents = True   'should be part of Change macro
End Sub
Another Example User, 2004-05-10, did not want to reinsert if already done. 
Checking will be from current row and from next row in a separate macro that calls InsertRowsAndFillFormulas.  Didn’t need test for .HasFormula
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   '-- Code example to prevent reinserting if the current row
   '-- or next row row has Column A cel empty (testing with TRIM).
   Dim x As Long
   Cancel = True  'turn off Edit, mode applicable to "Edit directly in a cell"
   x = ActiveSheet.UsedRange.Rows.Count 'may alleviate some lastcell problems
   Target.Offset(1, 0).EntireRow.Interior.ColorIndex = xlNone  '--Testin
   If Trim(ActiveCell.Offset(0, 1 - ActiveCell.Column)) = "" _
   Or Trim(ActiveCell.Offset(1, 1 - ActiveCell.Column)) = "" Then
     MsgBox "skipping due to formula in column C and nothing in Column A --testing"
     Exit Sub
   End If
   Application.Run "personal.xls!InsertRowsAndFillFormulas", 1
   Target.Offset(1, 0).EntireRow.Interior.ColorIndex = 36  '--Testing
End Sub

Double-click to insert row Before target (#before)

The following event macro might be used to insert a single row before the a Subtotal Row, by double-clicking on the subtotal row.  The content will be copied down into the inserted row, and the inserted row would have it's constants removed.  This is a macro for the specific worksheet so it is easy to have it only remove content out of particular columns using Intersect, if you don't want to just remove constants.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   'D.McRitchie,  2007-05-11, not posted
   Cancel = True
   Target.Offset(0).EntireRow.Insert
   Target.Offset(-2).EntireRow.Copy Target.Offset(-2).EntireRow
   On Error Resume Next
   Target.Offset(-1).EntireRow.SpecialCells(xlConstants).ClearContents
   On Error GoTo 0
End Sub

Change Event (#change_event)

For those that want something automatic, but will be inserting their own rows this might work for them.  The following is a Change Event macro.  It will fill in the formulas from the row above when entering a constant (text or number) into Column A provided the remainder of the row is empty.  This should work similar to the InsertRowsAndFillFormulas macro at the top, except that you will have to use the Insert menu to insert rows and the formulas will not be filled in until something is entered in column A.  One caveat, if anything is entered into a cell before entering into column A on the row this macro will not be filling in formulas, though the Extend formulas and formats will sometimes fill in the formulas as wanted. 
Remember Event macros are installed differently from standard macros.
Private Sub Worksheet_Change(ByVal Target As Range)
  'David McRitchie,  2005-05-03    insrtrow.htm
  '-- will copy more often than  Extend Formulas and Format (tools option)
  Dim lastrow As Long, rng As Range
  If Target.Column <> 1 Then Exit Sub
  If Target.row < 2 Then Exit Sub
  If IsEmpty(Target) Then Exit Sub
  Set rng = Intersect(Target.EntireRow, Range("B:IV"))
  If Application.Count(rng) > 0 Then Exit Sub
  rng.Offset(-1).Copy
  rng.Select
  On Error GoTo abort_sub
  Application.EnableEvents = False   'should be part of Change macro
  ActiveSheet.Paste
  Application.CutCopyMode = False
  rng.SpecialCells(xlConstants).ClearContents
abort_sub:
  Application.EnableEvents = True   'should be part of Change macro
End Sub

Additional Standard Macros (#more_macros)

Insert Blank Rows (#InsertBlankRows)

Simpler than InsertRowsAndFillFormulas,  just insert a number of empty rows after each existing row (#InsertBlankRows)

Sometimes too many bells and whistles are added that make it hard to see what is actually happening.  The following simply inserts empty rows and nothing else.

Sub InsertBlankRows()
'-- Ken Wright, 2003-08-09
Application.ScreenUpdating = False
Dim numRows As Long
Dim r As Long
Dim Rng As Range
Dim lastrw As Long    
numRows = InputBox("How many Rows")
  'Note: cells(r,1) is same as cells(r,"A")
lastrw = Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = Range(Cells(1, "A"), Cells(lastrw, "A")) 
   For r = Rng.Rows.Count To 1 Step -1
       ' (r+1) to insert AFTER,   (r)  to insert BEFOE
       Rng.Rows(r + 1).Resize(numRows).EntireRow.Insert
   Next r
Application.ScreenUpdating = True
End Sub
Insert one blank row before the last cell in Column A with content (not empty)
Sub InsertBlankRowBeforeLast()
   Cells(Rows.Count, "A").End(xlUp).EntireRow.Insert
End Sub

Additional insertion of rows, Examples: (#morex)

Sub InsertBeforeTotalinColumnA()
    Columns("A:A").Find(What:="total", After:=Range("A2"), LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=False).Offset(-1, 0).Activate
    Call InsertRowsAndFillFormulas(1)   'see my  insrtrow.htm  page
End Sub

Sub Guarantee2RowsAfterA_values()
    Dim rng As Range, i As Long
    Set rng = Intersect(Columns("A:A"), ActiveSheet.UsedRange)
    For i = rng.Cells.Count - 1 To 1 Step -1
      If Trim(rng(i).Value) <> "" Then
        If Trim(rng(i + 1)) <> "" Then
         rng.Item(i).Offset(1, 0).Resize(2).EntireRow.Insert
        ElseIf Trim(rng(i + 2)) <> "" Then
         rng.Item(i).Offset(1, 0).EntireRow.Insert
        End If
      End If
   Next i
End Sub

Sub Guarantee3RowsAfterA_values()
    Dim rng As Range, i As Long
    Set rng = Intersect(Columns("A:A"), ActiveSheet.UsedRange)
    For i = rng.Cells.Count - 1 To 1 Step -1
      If Trim(rng(i).Value) <> "" Then
        If Trim(rng(i + 1)) <> "" Then
         rng.Item(i).Offset(1, 0).Resize(3).EntireRow.Insert
        ElseIf Trim(rng(i + 2)) <> "" Then
         rng.Item(i).Offset(1, 0).Resize(2).EntireRow.Insert
        ElseIf Trim(rng(i + 3)) <> "" Then
         rng.Item(i).Offset(1, 0).EntireRow.Insert
        End If
      End If
   Next i
End Sub  

Sub Macro18()
    Dim C As Long
    C = 3       'Number of rows to insert
    Range("b15").Select   'below this cell

    ActiveCell.Offset(1, 0).EntireRow. _
       Resize(rowsize:=C).Insert Shift:=xlDown

End Sub
Code for inserting 3 up to 3 blank rows can be found on the code that corresponds with this web page.

Code to insert rows within a selection up to a specified quota of blank rows between populated rows (based on Column A) can be found in a reply based on Sean Bartleet's code in same thread (programming, 2005-10-20), it will be easier to read code here but check thread for comments.

The macro, Insert_Rows_between_existing, can be seen on the code/insrtrow.txt page and has a couple of minor corrections since posted, but the main points of what the code does and usage are summarized as follows:

More Resize examples (#moreresize)

Select the nth and nth+1 columns of the range “whatever” on the active sheet (though you probably shouldn’t be selecting them, but just doing whatever you want to do with respect to them) -- Alan Beban.       Range("whatever").Columns(n).Resize(,2).Select     -- example to resize columns
      Range("whatever").Rows(r).Resize(2).Select           -- example to resize rows

With a column already selected, also select the column to the left or to the right, examples by Tom Ogilvy
      Selection.Offset(0,-1).Resize(,2).Select
      Selection.Resize(,2).Select
-or-
      Union(Selection,Selection.Offset(0,-1)).Select
      Union(Selection,Selection.Offset(0,1)).Select

Install a button to invoke macro [Insert Row] for InsertRowsAndFillFormulas

I created a macro button that has colors and resembles a inserted line   Refer to toolbars page for some help in setting up such a button.

Background for INSRTROW macro (comment added 2000-02-01)

Creating such a macro proved difficult and I could not get the answers I wanted for a generic solution from the newsgroup.   http://groups.google.com/groups?oi=djq&ic=1&selm=an_327694444

So I searched what is now Google archives for the closest solution (1997/09/24 Mark Hill) to my problem and then posted that code with a description of what I really wanted and was surprised that a one line addition (1998/03/11 Bill Manville) would remove the constants.  Aren’t newsgroups great!

Also from Bill’s reply learned to use OFFSET in formulas to remove the need to modify formulas after running the macro.  A small price to pay for the benefit.   http://groups.google.com/groups?oi=djq&ic=1&selm=an_333104660

When you think everything is done, find out that the macro will not work for grouped (multiple selected) sheets.  Gary L. Brown, 2001-01-16, added looping through the selected sheets; and I sloppily corrected that to reselect the sheets in the group before macro was run.

Some customized changes

   '---- additionally clear out columns B and D  in the inserted rows
   '---- Columns B & D were entered as formulas, but are to be cleared anyway
    Dim multi_range As Range
    Dim new_area As Range
    Set multi_range = Application.Union(Range("b:b"), Range("d:d"))
    Set new_area = Selection.Offset(1).Resize(vRows).EntireRow
    on error resume next
    Intersect(new_area, multi_range).ClearContents
    on error goto 0 
To retain constants, code as formulas:   i.e.  ="abc"

Worksheet_Change event   (#ChangeEvent)

The following Worksheet_Change event could be used to create the formulas on the line when the date is typed into the B column.  The InsertRow macro is still preferable because the copy will copy the formatting for cells (number & colors).  More on Change Events on my event.htm page.

A change event will not recognize entry of a date with a short-cut (Ctrl+;), nor will it recognize a change by pasting a value.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'to install -- right-click on the sheettab of the corresponding
' sheet and choose 'view code'.  Paste the following procedure
' in the module.
  If Target.Column <> 2 Then Exit Sub
  If Target.Row = 1 Then Exit Sub  
  On Error goto ErrHandler
  Application.EnableEvents = False
  Dim R As Long
  R = Target.Row
  Target.Offset(0, -1).Formula = _
     "=IF(B" & R & "="""","">"",WEEKDAY(B:b,1))"
  Target.Offset(0, 5).Formula = _
     "=OFFSET(G" & R & ",-1,0)-F" & R & "+E" & R
  Target.Offset(0, 6).Formula = _
     "=IF(NOW()>B" & R & "+5,""*"","""")"
  Target.Offset(0, 10).Formula = _
     "=IF(OR(G" & R & "<250,M" & R & " <300),""XX"","""")"
  If Target.Offset(0, 11).Formula = "" then _
    Target.Offset(0, 11).Formula = _
     "=IF(H" & R & "<>"""",OFFSET(M" & R & ",-1,0)+E" _
     & R & "-F" & R & ",OFFSET(M" & R & ",-1,0))"
    '=IF(H604<>"",OFFSET(M604,-1,0)+E604-F604,OFFSET(M604,-1,0)) '--
    Target.Offset(0, 12) = R
 ErrHandler: 
  Application.EnableEvents = True
End Sub

Extended List Formats and Formulas   (#extend)

Related to automatically entering formulas, this may be useful for some applications.  I found the option very annoying.
 
Turn on or off extended formats and formulas

When you turn on extended formats and formulas, Microsoft Excel automatically formats new data that you type at the end of a list to match the preceding rows and automatically copies formulas that repeat in every row. To be extended, formats and formulas must appear in at least three of the five list rows preceding the new row.

  1. On the Tools menu, click Options, and then click the Edit tab.
  2. Do one of the following:
    To automatically format new items that you add to the end of a list to match the format of the rest of the list, select the Extend list formats and formulas check box.
    To prevent automatic formatting, clear the check box.

Actually I now have it turned on, it probably is just a matter of getting used to it.  You might take a look at Q231002 -- XL2000: How Auto Extend List Behavior Works

Icons on the Worksheet in Excel 2002, introduces an icon that appears next to inserted cells when formatting of insertion does not match.  0108.gif

Some Macros for inserting blank rows on alternate lines   (#AltBlanks)

The following macro will insert a row BEFORE any row in which the cell in Column A is not blank, with the exception of before the first row.  It inserts lines from the bottom of the Used range upward so inserted lines do not interfere with counting.  Blank here is anything that looks like a blank.  If you want to insert regardless of content in Column A, then remove the condition.
Sub InsertALTrows()
'David McRitchie,  misc  2000-01-27
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual   'pre XL97 xlManual
Dim i as long
i = ActiveSheet.UsedRange.Rows.Count   'attempt to fix last cell location
For i = Cells.SpecialCells(xlLastCell).Row To 2 Step -1
  If Len(Trim(Cells(i, 1))) <> 0 Then Rows(i).Insert  ' 1 is Column A
Next i
Application.Calculation = xlCalculationAutomatic   'pre XL97 xlAutomatic
Application.ScreenUpdating = True
End Sub
Insert1or2RowsBeforeNonBlankA() use the following code to insert 1 or 2 rows before the any value in Column A.  If there is a value in A immediately above only one row; otherwise, 2 rows.
For i = Cells.SpecialCells(xlLastCell).Row To 2 Step -1
  If Len(Trim(Cells(i, 1))) <> 0 Then
    If Len(Trim(Cells(i - 1, 1))) <>  0 Then
       Rows(i).Insert Shift:=xlDown
    Else
       Rows(i + 1).Resize(2).Insert Shift:=xlDown
    End If
  End If

If there is a value in A immediately above; oth othnav The following macro will insert a row between existing rows in a selection  any row

Sub InsertALTrowsInSelection()
'David McRitchie,  misc  2001-06-30
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual   'pre XL97 xlManual
Dim i As Long
For i = Selection(Selection.Count).Row To Selection(1).Row + 1 Step -1
  Rows(i).Insert
Next i
Application.Calculation = xlCalculationAutomatic   'pre XL97 xlAutomatic
Application.ScreenUpdating = True
End Sub
An alternative to this may simply be to increase the height of all rows to provide some spacing that would not be lost due to sorting.

Another alternative might be the use of Conditional formatting to color alternate rows:
    =INT(ROW($A1)/2)*2=ROW($A1)
also see Coloring within Ranges.

Insert Blank Rows on Column A change of value   (#ColAchg)

The comparison using .Text instead of .Value allow mixtures with #N/A error cells without additonal checking.  Text is what is seen and includes formatting.
Sub InsertRow_A_Chg()
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Dim irow As Long, vcurrent As String, i As Long
 '// find last used cell in Column A
  irow = Cells(Rows.Count, "A").End(xlUp).Row
 '// get value of  that cell in Column A (column 1)
  vcurrent = Cells(irow, 1).Text
 '// rows are inserted by looping from bottom
  For i = irow To 2 Step -1
     If Cells(i, 1).Text = "" Then
       vcurrent = Cells(i - 1, 1)
     ElseIf Cells(i, 1).Text <> vcurrent Then
        vcurrent = Cells(i, 1).Text
        Rows(i + 1).Insert
     End If
  Next i
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

Insert Blank Rows above cells in Column A with a specific value (#before_a)

This macro includes turning off screen updating and calculation to make this run quickly.  The macro can be rerun without reinserting empty rows because a check is made of the cell above before inserting a row.  Test for SpecialCells reduces the focus to the used range, and xltextvalues specifically restricts to cells with a constant value (not empty, not a formula).  Longs are dimensioned (DIM) as Long for speed and more important because 65,536 rows can be in spreadsheet and integer is limited to 32,768.
Option Explicit
Sub InsertBefore_a_in_ColumnA()
  Dim cell As Range, rng As Range
  Dim i As Long, iCnt As Long
  Set rng = Columns("A").SpecialCells(xlConstants, xlTextValues)
  If rng Is Nothing Then Exit Sub
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  iCnt = rng.Count
  For i = iCnt To 1 Step -1
    If rng.Item(i).Row = 1 Then GoTo done
    If Trim(LCase(rng.Item(i))) = "a" Then
       If Not IsEmpty(rng.Item(i).Offset(-1, 0)) Then
          rng.Item(i).EntireRow.Insert Shift:=xlDown
       End If
    End If
  Next i
done:
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

Related coding

Is there a way to calculate a cell reference?  i.e.  +C2 calculated as +C(1+1)
    =INDIRECT(C2)
    =INDIRECT("C"&1+1)

    =INDIRECT(address(row(C1)+1, column(C1))
The inclusion of address helps correct formulas if you insert or delete lines.

Adjusting coding when named cells are used

If the formula to be replicated starts in A2, try the following:
    =OFFSET(pension,row(a2)-row($A$2),0)+OFFSET(taxable_income,row(A2)-row($A$2),0)

Bank Reconciliation by Check Numbers   (#reconcile)

Thought you might find this one interesting.  VLOOKUP was suggested by Myrna Larson in the MISC newsgroup.

Problem: Reconcile bank statement.  Two files received electronically.  One includes checks issued with check number in Column A, and the other file has checks paid and also includes the check #.  How can the two columns of check numbers be compared to show outstanding checks.

Solution: Try a VLOOKUP formula with the last argument set to 0.  If a check isn't found in the bank’s list, the formula will show #NA.

I like my checkbook worksheet, but if you don’t here is a program that keeps track of type transaction as well Easy Checkbook for Excel PC World.

Inserting Lines -- Manual Alternative   (#ManualInsert)

For more on shortcuts see my shortcut pages shortx2k, and shortx95 for additional information.
 
 XL2000 Keyboard Shortcuts Keystrokes to invoke MenuRt.Click Menu
 Insert blank cellsCTRL+SHIFT+PLUS SIGN Insert --> Rowsinsert rows
 Fill downCTRL+DEdit--> Fill--> Down
N/A
There are also Mouse Shortcuts Mouse, largely undocumented in HELP, Use of Mouse and keys to move, and insert rows or columns.

To insert multiple lines, first select a range of the number of rows you want to insert, then use shortcut, or Insert menu to insert the rows before the selection.  (note: INSRTROW macro inserts rows with formulas down from the active cell row).

The advantage with the macro includes, being able to insert lines below rather than above, being able to specify number of rows to insert rather than selecting the exact number of rows to insert, and to remove the constant information while retaining the formulas which reduces problems with inadvertent duplicate entries.

Manually removing constants from selection  (#DeleteK)

To preserve some constants and information from the above removal, don't include those columns in your selection, or you can code as formulas:
   Provide numeric constant in a formula   i.e.  =3.14
   Provide text constant in a formula   i.e.  =text("abc def","@")
   Use some text boxes to provide information.

Deleting Rows   (#DeleteR)

The antithesis of InsertRowsAndFillFormulas described here is DeleteBlankRows in Chip Pearson’s Excel pages.  Caution: I had to comment out two lines beginning with Application.Calculation to avoid a runtime error 1005 on my system (XL95 under WinNT).  Also check out an article by John Walkenbach Delete All Empty Rows in a Flash (Oct 1997 PC World).  If you delete rows at end of spreadsheet you should also review my article Reset Last Cell Used.

If you are going to delete rows you will want to work your way up from the bottom, so you don’t trip yourself up by skipping rows you haven’t examined or by deleting the wrong row.

    dim rw as long
    For rw = ActiveSheet.UsedRange.Rows.Count to 1 step -1
     if cells(rw,"A")="" then rows(rw).delete
    next
The above loop is really not needed, read more about this in delempty.htm (Dana DeLouis)
    On Error Resume Next     ' In case there are no blanks
    Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    ActiveSheet.UsedRange 'Resets UsedRange for Excel 97
Delete All Rows that are completely empty
  Sub RemoveEmptyRows()
    Application.ScreenUpdating = False  'xlManual below in Xl95
    Application.Calculation = xlCalculationManual 
    Dim rw As Long, iCol As Long
    For rw = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
      If Application.CountA(Rows(rw).EntireRow) = 0 Then _
            Rows(rw).Delete
    Next
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True  'xlAutomatic above in xl95
  End Sub
Within your own existing code possibilities include:
    Selection.Rows.EntireRow.Delete
    ActiveCell.Rows.EntireRow.Delete
    Cells(16, 2).Rows.EntireRow.Delete
    Selection.EntireRow.Delete

More on Inserting Rows   (#addendum)

    Rows("15:15").Insert Shift:=xlDown

    'insert cells based on content in A1'
    N = Range("A1").Value
    ActiveCell.Resize(N).EntireRow.Insert

Adding/Subtracting with sign on Right   (#sign_onright)

Transactions came in from my new bank with a single entry column (col C), and a Balance column (Col D).  The following is placed in Column E to verify the figures supplied in column D to make sure all transactions are present.  Actually I used Replace ALL to remove + from Balance column and $ from Transaction and Balance Column.  (also see #fixrightminus)
=IF(RIGHT(C5,1)="-",E4-LEFT(C5,LEN(C5)-1),

    IF(RIGHT(C5,1)="+",E4+LEFT(C5,LEN(C5)-1),E4+C5))
 ABCDE
1 Date Description Amount Balance Verification
2 08/19/1999 BEGINNING BALANCE   600.00 600.00
3 08/19/1999 PURCHASE GROCER #1111 33.42- 566.58 566.58
4 08/30/1999 CHECK NUMBER #101 190.96- 375.62 375.62
5 09/05/1999 PURCHASE GROCER #1111 67.05- 308.57 308.57

Extending the example a little, the point is that a macro is not used, the purpose is to leave the original transaction data from the bank untouched, but the verification will make sure that everything is included as long as it matches the banks figure.

Date------ Description------ Amount*  Balance Verification Checks**  Loc.  10002
xx/xx/1999 CHECK NUMBER nnnn $46.00- $269.66+       269.66 CHK nnnn        10020
xx/xx/1999 PURC. store #xxxx $53.56- $216.06+       216.06           #xxxx 10021

=IF(RIGHT(C8,1)="-",E7-LEFT(C8,LEN(C8)-1),IF(RIGHT(C8,1)="+",E7+LEFT(C8,LEN(C8)-1),E7+C8))

=IF(LEFT(B8,13 )="CHECK NUMBER ","CHK " & MID(B8,14,99),"")

=IF(LEFT(RIGHT(B8,5),1)="#",RIGHT(B8,5),"")

Fix Right Minus sign (#fixrightminus)

Fix Right Minus -- A Worksheet solution

This is a continuation of the previous topic and example.  Following is a Worksheet solution to display a single value from another cell.
  =IF(RIGHT(D12,1)="-",-1*LEFT(D12,LEN(D12)-1)+0,D12)

FixRightMinus -- A Macro solution

Change right minus text constant cells in selection to negative numbers.  You can change formatting before or after running the macro.
Sub FixRightMinus()
   'David McRitchie   2000-02-04 rev 2000-05-01, CR 2002-10-29 
   ' CDBL rev. based on Dana DeLouis and Peter Surcouf
   ' prior to XL97 use  xlManual and xlAutomatic
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   Dim cell As Range
   On Error Resume Next
   For Each cell In Selection.Cells.SpecialCells(xlConstants, xlTextValues)
      cell.Value = CDbl(Replace(cell.Value, "CR", "-"))
   next cell
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
End Sub
Solution above was revised based on solution which uses CDbl and On Error Resume from (Peter Surcouf and Dana DeLouis), which converts entire sheet rather than selected range.  In any case the following is redundant and is replaced by one line. 
     If Right(cell.Value, 1) = "-" Then
       cell.Value = -1 * Left(cell, Len(cell.Value) - 1)
     End If
XL2002 has a button [Advanced], on wizard panel to indicate trailing minus (when you tell it what format General|Date|skip|etc).   Dave Peterson 2002-01-02 programming

For those who want to do the entire workbook.

Sub CycleSheetsForRightMinus()
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Dim ws As Worksheet
  Dim cell As Range
  For Each ws In ActiveWorkbook.Worksheets
      Worksheets(ws.Name).Activate
      On Error Resume Next
      'have changed selection.cells to   cells
      For Each cell In Cells.SpecialCells(xlConstants, xlTextValues)
         cell.Value = CDbl(cell.Value)
      Next cell
  Next ws
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

Clear certain columns on active row   (#clearCols)

Since INSRTROW the focus of this page clears out constants, I thought this macro might be of interest.  It will indiscriminently delete particular columns on the row of the active cell and will not change the active cell.
Sub ClearCells()
'leo.heuser@get2net.dk, misc,  2000-11-22 <uFwUNysUAHA.244@cppssbbsa05>
'  http://groups.google.com/groups?oi=djq&ic=1&selm=an_696636903
Dim ClearRange As Range
Dim Area As Range
Dim RowNumber As Variant

    Set ClearRange = Range("B:I,N:O")
    RowNumber = ActiveCell.Row
    If RowNumber > 1 Then
        For Each Area In ClearRange.Areas
            Area.Rows(RowNumber).ClearContents
        Next Area
    End If
    ActiveCell.Activate

Set ClearRange = Nothing
Set Area = Nothing
End Sub

Maintaining a Total at two Rows below last input data in Column A   (#extraTotals)

Use this formula in your last row i.e.  last row is 20.  (posted 2001-05-01 D.McRitchie)
   A20: 'Total
   C20: =SUM(C2:OFFSET(C20,-1,0))

Install the following event macro on the sheet, so that when the cell above the last cell in Column A is filled in a row will be inserted before the last last cell in Column A.  This should work better than actually using the last cell row, since last cell problems happen.  This example will not replicate formulas.

Private Sub Worksheet_Change(ByVal Target As Range)
'to install -- right-click on the sheettab of the sheet to
' be used in and choose 'view code'.  Paste this Worksheet
' event macro into the module.
  If Target.Column <> 1 Then Exit Sub
  'find last cell in column  -- not going to use the last cell row
  If Cells(Cells(Rows.Count, 1).End(xlUp).Row - 1, 1).Value <> "" Then
     Rows(Cells(Rows.Count, 1).End(xlUp).Row).Insert
  End If
End Sub

Inserting Two Blank Rows (#blankrows)

The following is from Dana DeLouis, 2001-05-13, programming, where he points out that Resize is faster.  Dana frequently comes up with time saving tips.  If you look at the posting he also includes a programmed approach that does not involve a loop.
Sub InsertTwoRows_v2()
  'Dana De Louis, programming, 2001-05-13
  Dim r As Long
  For r = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
    Rows(r).Resize(2).Insert
  Next
End Sub

Printing Multiple Labels based on Column A (#multilabel)

See macro RepeatRowsOnColumnA in Mail Merge for a macro to repeat rows based on number in Column A, which would be needed by Mail Merge to print multiple labels with same content.

#VALUE! Errors on Checkbook Balance Column (#VALUE)

If you have text in a cell in your Debit or Credit column instead of a number or an empty cell you will get #VALUE! errors in your balance column.  You can use Edit, Goto, Special Values, text to identify problem, or you can use Conditional Formatting so you can spot problems as they occur later on.  While doing Conditional Formatting might also set up a second formula to catch lack of a formula in your balance column (i.e. an Empty cell)

Using the examples on this page you see you have Debits in column E, your Credits in Column F, and your Balance in Column G. Your Conditional Formatting formula is based on your active cell, the cells that can be colored is based on your selection.

Cells containing Text in columns E and F would be invalid, to check for use ...
  Select columns E:F with cell E1 as the active cell
  Format, Conditional Formatting,
  Formula is:  =AND(ROW()<>1,ISTEXT(E1))
  format button, patterns, choose a color (orange), OK, OK

To check for a break in your balance column as in a missing formula by testing for numeric, use ...
  Select column G then with G1 as the active cell.
  Format, Conditional Formatting,
  Formula is:  =AND(ROW()<>1,NOT(ISNUMBER(G1)))
  format button, patterns, choose a different color (turquoise), OK, OK

You should see very easily now why you have #VALUE! errors because you have text values.  The second color will indicate where you have an empty row and your balances start over rather than continue.

 
 EFGH
 1 Debit  Credit Balance  formula
 2 500    500  500 
 3 2    502   =OFFSET(G3,-1,0)+E3-F3
 4   40  462   =OFFSET(G4,-1,0)+E4-F4
 5 a   #VALUE!  =OFFSET(G5,-1,0)+E5-F5
 6   40  #VALUE!  =OFFSET(G6,-1,0)+E6-F6
 7 10   (space) #VALUE!  =OFFSET(G7,-1,0)+E7-F7
 8 20     
 9 1    1   =OFFSET(G9,-1,0)+E9-F9
10   30  -29   =OFFSET(G10,-1,0)+E10-F10
11 D  B #VALUE!  =OFFSET(G11,-1,0)+E11-F11
12 A  H #VALUE!  =OFFSET(G12,-1,0)+E12-F12
13     
14     

More information on Conditional Formatting, debugging what type of data you have, and the reason why you don’t use SUM in your checkbook balances.

Balance Carried to another sheet (#carrybalance)

A rather novel approach posted by Don Guillet, 2004-03-08, this will find the last number on sheet2 in col F.  The trick is to look for a large number that can’t exist. Just make sure that your number is not larger than your criteria.  The last number is selected even if nonnumbers appear below.
  =INDEX(Sheet2!F:F,MATCH(9999999999,Sheet2!F:F),1)

Problems (#problems)


This page was introduced on March 23, 1998. 

 

[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