PDA

View Full Version : Worksheet change copy row &paste above macro



Dave T
01-15-2013, 10:22 PM
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 B13I 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
01-15-2013, 11:45 PM
This might help (in the sheet1 code module):

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

Dave T
01-16-2013, 12:06 AM
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
01-16-2013, 04:10 PM
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
01-16-2013, 05:46 PM
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
01-16-2013, 06:31 PM
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