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