Insert Row and Copy Down From Above
 

Hi All,

I am trying to write some code to allow my users to insert a row whee
they would like and then copy the information from the row above down

Ex:

User is selected on B8 which contains "Sally Sue"
User want to add another row for Sally Sue
A row is created at Row 9 and B9 contains "Sally Sue"

My code below is giving odd results and I'm not sure why

Thanks!
goss

Sub InsertRowCurrentEmployee()

Dim wb As Workbook
Dim ws As Worksheet
Dim rngCopy As Range
Dim rngDest As Range
Dim rngStart As Range
Dim lngRows As Long
Dim R As Long


Set wb = ThisWorkbook
Set ws = wb.Worksheets("Time")

ws.Unprotect Password:="employee"

'Test to make sure at least 1 employee loaded
lngRows = ws.Range("B65536").End(xlUp).Row
Debug.Print lngRows
If lngRows = 9 Then
R = ActiveCell.Row
Debug.Print R
Cells(R, 2).End(xlUp).Offset(1, 0).EntireRow.Insert
Debug.Print Cells(1, 2).Offset(1, 0).Address
' Set rngCopy = ws.Range("B" & R & ":J" & R)
' rngCopy.Copy Cells(R, "B").Offset(1, 0)
End If



Cleanup:

ws.Protect Password:="employee"

Set wb = Nothing
Set ws = Nothing
Set rngCopy = Nothing
Set rngDest = Nothing
Set rngStart = Nothing

ActiveSheet.Protect UserInterfaceOnly:=False
End Sub

Insert Row and Copy Down From Above
 

I'm not quite sure I understand, but it looks like you're using the activesheet.

Maybe this would be enough:

Option Explicit
Sub InsertRowCurrentEmployee2()

Dim myRow As Long

myRow = ActiveCell.Row

If myRow < 9 Then
Exit Sub
End If

With ActiveSheet
.Unprotect Password:="employee"
.Rows(myRow + 1).Insert
.Cells(myRow, "B").Copy _
Destination:=.Cells(myRow + 1, "B")
.Protect Password:="employee", UserInterfaceOnly:=False
End With

End Sub


-goss wrote:

Hi All,

I am trying to write some code to allow my users to insert a row whee
they would like and then copy the information from the row above down

Ex:

User is selected on B8 which contains "Sally Sue"
User want to add another row for Sally Sue
A row is created at Row 9 and B9 contains "Sally Sue"

My code below is giving odd results and I'm not sure why

Thanks!
goss

Sub InsertRowCurrentEmployee()

Dim wb As Workbook
Dim ws As Worksheet
Dim rngCopy As Range
Dim rngDest As Range
Dim rngStart As Range
Dim lngRows As Long
Dim R As Long

Set wb = ThisWorkbook
Set ws = wb.Worksheets("Time")

ws.Unprotect Password:="employee"

'Test to make sure at least 1 employee loaded
lngRows = ws.Range("B65536").End(xlUp).Row
Debug.Print lngRows
If lngRows = 9 Then
R = ActiveCell.Row
Debug.Print R
Cells(R, 2).End(xlUp).Offset(1, 0).EntireRow.Insert
Debug.Print Cells(1, 2).Offset(1, 0).Address
' Set rngCopy = ws.Range("B" & R & ":J" & R)
' rngCopy.Copy Cells(R, "B").Offset(1, 0)
End If

Cleanup:

ws.Protect Password:="employee"

Set wb = Nothing
Set ws = Nothing
Set rngCopy = Nothing
Set rngDest = Nothing
Set rngStart = Nothing

ActiveSheet.Protect UserInterfaceOnly:=False
End Sub

--

Dave Peterson

Insert Row and Copy Down From Above
 

Hi

Try this:

Sub InsertRowCurrentEmployee()


Dim wb As Workbook
Dim ws As Worksheet
Dim rngCopy As Range
Dim rngDest As Range
Dim rngStart As Range
Dim lngRows As Long
Dim R As Long


Set wb = ThisWorkbook
Set ws = wb.Worksheets("Time")


ws.Unprotect Password:="employee"


'Test to make sure at least 1 employee loaded
lngRows = ws.Range("B65536").End(xlUp).Row
Debug.Print lngRows
If lngRows = 9 Then
R = ActiveCell.Row
Debug.Print R
Cells(R, 2).Offset(1, 0).EntireRow.Insert
Debug.Print Cells(1, 2).Offset(1, 0).Address
Set rngCopy = ws.Range("B" & R & ":J" & R)
rngCopy.Copy Cells(R, "B").Offset(1, 0)
End If


Cleanup:


ws.Protect Password:="employee"


Set wb = Nothing
Set ws = Nothing
Set rngCopy = Nothing
Set rngDest = Nothing
Set rngStart = Nothing


ActiveSheet.Protect UserInterfaceOnly:=False
End Sub

Regards,
Per


On 2 Nov., 23:32, -goss wrote:
Hi All,

I am trying to write some code to allow my users to insert a row whee
they would like and then copy the information from the row above down

Ex:

User is selected on B8 which contains "Sally Sue"
User want to add another row for Sally Sue
A row is created at Row 9 and B9 contains "Sally Sue"

My code below is giving odd results and I'm not sure why

Thanks!
goss

Sub InsertRowCurrentEmployee()

* * Dim wb As Workbook
* * Dim ws As Worksheet
* * Dim rngCopy As Range
* * Dim rngDest As Range
* * Dim rngStart As Range
* * Dim lngRows As Long
* * Dim R As Long

* * Set wb = ThisWorkbook
* * Set ws = wb.Worksheets("Time")

* * ws.Unprotect Password:="employee"

* * 'Test to make sure at least 1 employee loaded
* * * * lngRows = ws.Range("B65536").End(xlUp).Row
* * * * Debug.Print lngRows
* * * * If lngRows = 9 Then
* * * * * * R = ActiveCell.Row
* * * * * * Debug.Print R
* * * * * * Cells(R, 2).End(xlUp).Offset(1, 0).EntireRow.Insert
* * * * * * Debug.Print Cells(1, 2).Offset(1, 0).Address
' * * * * * *Set rngCopy = ws.Range("B" & R & ":J" & R)
' * * * * * *rngCopy.Copy Cells(R, "B").Offset(1, 0)
* * * * End If

Cleanup:

* * * * ws.Protect Password:="employee"

* * * * Set wb = Nothing
* * * * Set ws = Nothing
* * * * Set rngCopy = Nothing
* * * * Set rngDest = Nothing
* * * * Set rngStart = Nothing

* * * * ActiveSheet.Protect UserInterfaceOnly:=False
End Sub

Insert Row and Copy Down From Above
 

On Nov 2, 4:24*pm, Per Jessen wrote:
Hi

Try this:

Sub InsertRowCurrentEmployee()

* * Dim wb As Workbook
* * Dim ws As Worksheet
* * Dim rngCopy As Range
* * Dim rngDest As Range
* * Dim rngStart As Range
* * Dim lngRows As Long
* * Dim R As Long

* * Set wb = ThisWorkbook
* * Set ws = wb.Worksheets("Time")

* * ws.Unprotect Password:="employee"

* * 'Test to make sure at least 1 employee loaded
* * * * lngRows = ws.Range("B65536").End(xlUp).Row
* * * * Debug.Print lngRows
* * * * If lngRows = 9 Then
* * * * * * R = ActiveCell.Row
* * * * * * Debug.Print R
* * * * * * Cells(R, 2).Offset(1, 0).EntireRow.Insert
* * * * * * Debug.Print Cells(1, 2).Offset(1, 0).Address
* * * * * * Set rngCopy = ws.Range("B" & R & ":J" & R)
* * * * * * rngCopy.Copy Cells(R, "B").Offset(1, 0)
* * * * End If

Cleanup:

* * * * ws.Protect Password:="employee"

* * * * Set wb = Nothing
* * * * Set ws = Nothing
* * * * Set rngCopy = Nothing
* * * * Set rngDest = Nothing
* * * * Set rngStart = Nothing

* * * * ActiveSheet.Protect UserInterfaceOnly:=False
End Sub

Regards,
Per

On 2 Nov., 23:32, -goss wrote:



Hi All,

I am trying to write some code to allow my users to insert a row whee
they would like and then copy the information from the row above down

Ex:

User is selected on B8 which contains "Sally Sue"
User want to add another row for Sally Sue
A row is created at Row 9 and B9 contains "Sally Sue"

My code below is giving odd results and I'm not sure why

Thanks!
goss

Sub InsertRowCurrentEmployee()

* * Dim wb As Workbook
* * Dim ws As Worksheet
* * Dim rngCopy As Range
* * Dim rngDest As Range
* * Dim rngStart As Range
* * Dim lngRows As Long
* * Dim R As Long

* * Set wb = ThisWorkbook
* * Set ws = wb.Worksheets("Time")

* * ws.Unprotect Password:="employee"

* * 'Test to make sure at least 1 employee loaded
* * * * lngRows = ws.Range("B65536").End(xlUp).Row
* * * * Debug.Print lngRows
* * * * If lngRows = 9 Then
* * * * * * R = ActiveCell.Row
* * * * * * Debug.Print R
* * * * * * Cells(R, 2).End(xlUp).Offset(1, 0).EntireRow.Insert
* * * * * * Debug.Print Cells(1, 2).Offset(1, 0).Address
' * * * * * *Set rngCopy = ws.Range("B" & R & ":J" & R)
' * * * * * *rngCopy.Copy Cells(R, "B").Offset(1, 0)
* * * * End If

Cleanup:

* * * * ws.Protect Password:="employee"

* * * * Set wb = Nothing
* * * * Set ws = Nothing
* * * * Set rngCopy = Nothing
* * * * Set rngDest = Nothing
* * * * Set rngStart = Nothing

* * * * ActiveSheet.Protect UserInterfaceOnly:=False
End Sub- Hide quoted text -

- Show quoted text -

Thanks guys.
Per, works great!

Many thanks!
Regards,
goss