Worksheet change copy row &paste above macro

[Dave T]

Hello All,

I have a table with the headings in row 11 (A11:J11) and I want to be able to copy row 12 and paste a blank copy of this row below the headings so that as data is entered there will always be a blank row below the heading row. All new data will therefore be entered in the row below the heading row.

As the rows below the headings have data validation and conditional formatting applied I thought it was probably easier to copy a row and delete any data that may be within the inserted row.

This is what I would like the Worksheet Change macro to be able to do:

• Data is entered into cell A12 which would trigger the Worksheet Change macro
• This event would copy row 12 and insert a copy of the row above the current row 12.
• Any data in cells A12:J12 would be deleted
• Any borders applied would be maintained (i.e. not copy the borders of the heading row)
• After the blank row has been inserted the next selected cell for more data entry would be B13

I hope this make sense...

I have found various macros, but I am having trouble modifying them to become Worksheet Change

Sub InsertCopyRow2()
'http://excel.tips.net/T002042_Inserting_and_Copying_Rows.html
  ActiveCell.Offset(1, 0).EntireRow.Insert
  ActiveCell.EntireRow.Copy ActiveCell.Offset(1, 0).EntireRow
End Sub

Sub InsertAtRow12()
'http://chandoo.org/forums/topic/macro-that-copies-a-cell-range-and-pastes-it-on-the-next-empty-row-it-finds
  Range("A12:J12").Select
  Selection.Copy
  Rows("12:12").Select
  Selection.Insert Shift:=xlDown
  Application.CutCopyMode = False
End Sub

Any help or suggestions would be appreciated

Regards,
Dave T

[Teeroy]

This might help (in the sheet1 code module):

[VBA]Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target.Address = Range("A12").Address And Target.Value <> "" Then
Me.Rows(12).Copy
Me.Rows(13).Insert Shift:=xlDown
Me.Rows(12).ClearContents
End If
Application.CutCopyMode = False
End Sub[/VBA]

[Dave T]

Hello Teroy,

Thank you very much for the macro, it does exactly what I was after.

I have added some extra code from a macro I recorded earlier and there is probably quite a bit of extra code in there that is not required, but having everything there is a help to me when I look through it to see what it does.

There may be better ways to do the extra bits I required and even to have cell B13 selected after the code has run.

Private Sub Worksheet_Change(ByVal Target As Range)
'http://www.vbaexpress.com/forum/showthread.php?p=283948#post283948
  If Target.Cells.Count > 1 Then Exit Sub
  If Target.Address = Range("A12").Address And Target.Value <> "" Then
    Me.Rows(12).Copy
    Me.Rows(13).Insert Shift:=xlDown
    Me.Rows(12).ClearContents
  End If
  'Extra coding below
  Me.Range("A11:J12").Select
  Application.CutCopyMode = False
  Selection.Borders(xlDiagonalDown).LineStyle = xlNone
  Selection.Borders(xlDiagonalUp).LineStyle = xlNone
  With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlMedium
  End With
  With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlMedium
  End With
  With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlHairline
  End With
  With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlMedium
  End With
  With Selection.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlThin
  End With
  With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlDouble
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlThick
  End With
  Application.CutCopyMode = False
  Range("B13").Select
End Sub

I appreciated your help.

Regards,
Dave T

[Dave T]

Hello All,

I have again modified the code (latest vesion below) as I did not always want to be in cell B13 every time the macro was triggered.

Not sure how to fix this but the Worksheet_Change for my borders is being triggered by every cell on the worksheet.

How do I modify the code so that all of the code (including my extra borders formatting) is only triggered by by cell $B$12.
Basically I was trying to achieve the following:

• If cell $A$12 and only cell $A$12 is blank the Worksheet_Change is not triggered even if changes are made to other cells in the worksheet
• When data is entered into cell $A$12 this should be the only time the Worksheet_Change is triggered
• When the Worksheet_Change has been triggered I would like cell $B$13 to be selected after the copied row has been inserted

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'http://www.vbaexpress.com/forum/showthread.php?p=283948#post283948
 
  Dim rng As Range    'Take focus off button when clicked
  Set rng = ActiveCell    'Take focus off button when clicked
'  If Target.Cells.Count > 1 Then Exit Sub    'Original code
'  If Target.Address = Range("$A$12").Address And Target.Value <> "" Then    'Original code
  If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub    'Modified code
  If Not Intersect(Target, Range("$A$12")) Is Nothing Then    'Modified code
 
    Me.Rows(12).Copy
    Me.Rows(13).Insert Shift:=xlDown
    Me.Rows(12).ClearContents
  End If
 
 Me.Range("$A$11:$J$12").Select
  Application.CutCopyMode = False
  Selection.Borders(xlDiagonalDown).LineStyle = xlNone
  Selection.Borders(xlDiagonalUp).LineStyle = xlNone
  With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlMedium
  End With
  With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlMedium
  End With
  With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlHairline
  End With
  With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlMedium
  End With
  With Selection.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlThin
  End With
  With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlDouble
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlThick
  End With
 
  Application.CutCopyMode = False
 
  rng.Select    'Take focus off button when clicked
 
End Sub

Any further comments or help would be appreciated.

Regards,
Dave T[/quote]

[Teeroy]

I'm confused. Do you want the trigger cell to be A12 or B12? And you talk about taking a focus off a button but the event is a worksheet_change, not a Button_click.
To stop the border formatting occurring you need to move the END IF to immediately before the END SUB.

[Dave T]

Hello Teeroy,

Sorry for any confusion.

Firstly... moving moving the END IF to before the END SUB has resolved the main problem.

Maybe the confusion was how I was trying to explain what happens after data entry into cell A12 triggers the Worksheet_Change macro.

Currently what was happening was that when A12 was triggered a blank copy of the row is inserted below the headings and when the macro had finished running cells A11 to J12 remain in focus (selected).

What I was trying to say was that when, and only when, cell A12 had triggered the event the next cell selected (in focus) should be B13.
I have played further with your last suggestion and did the following, which may have solved it:

Removed:

  Dim rng As Range
  Set rng = ActiveCell

And

  rng.Select

Added the following at the end as per your suggestion:

    Range("B13").Select
  End If
End Sub

All appears to be good now.
Thanks for pointing me in the right direction, your help is appreciated.

Regards,
Dave T