Transferring data from one sheet to another

[Jaytiluco]

Hi all,

I am currently working on an order form for our warehouse.

I have a master sheet (Template) which holds all the current items we stock. When entering the quantity to be ordered on the master sheet, it is transferred to the Order Form.

Here is the code used for the transfer of data:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("H:H")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Dim Lastrow As Long
Lastrow = Sheets("Order Form").Cells(Rows.Count, "A").End(xlUp).Row + 1
Rows(Target.Row).Copy Destination:=Sheets("Order Form").Rows(Lastrow)
Sheets("Order Form").Rows(Lastrow).Value = Sheets("Order Form").Rows(Lastrow).Value
End If
End Sub

A few problems I have been having:

When changing the quantity to be ordered from one value to another, it duplicates the item on the Order Form instead of updating the value.

I would like to password protect the Order sheet and lock all cells that don't require editing, but still allow the code to transfer data from the master sheet.

Any help would be greatly appreciated!

 

[mumps]

In order to what you want, each row (item) in the Template must have a unique identifier such as an ID or item number. Does your data contain unique identifiers? If not, can they be added?

 

[Jaytiluco]

In order to what you want, each row (item) in the Template must have a unique identifier such as an ID or item number. Does your data contain unique identifiers? If not, can they be added?

Correct.
My columns are as follows

A - Identifying number
B - Part Number
C - Description
D - Item Location
E - Unit of Measurement
F - Min Quantity
G - Max Quantity
H - Order Quantity



The Order forms follows the exact same template.

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("H:H")) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
    Application.ScreenUpdating = False
    Dim ID As Range, desWS As Worksheet
    Set desWS = Sheets("Order Form")
    Set ID = desWS.Range("A:A").Find(Range("A" & Target.Row), LookIn:=xlValues, lookat:=xlWhole)
    If Not ID Is Nothing Then
        Target.EntireRow.Copy desWS.Range("A" & ID.Row)
    Else
        Target.EntireRow.Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0)
    End If
    Application.ScreenUpdating = True
End Sub

 

[Jaytiluco]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("H:H")) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
    Application.ScreenUpdating = False
    Dim ID As Range, desWS As Worksheet
    Set desWS = Sheets("Order Form")
    Set ID = desWS.Range("A:A").Find(Range("A" & Target.Row), LookIn:=xlValues, lookat:=xlWhole)
    If Not ID Is Nothing Then
        Target.EntireRow.Copy desWS.Range("A" & ID.Row)
    Else
        Target.EntireRow.Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0)
    End If
    Application.ScreenUpdating = True
End Sub

That seems to have fixed the problems with changing values! Thank you!

The only problems I'm seeing are that removing a value from the H column after you have entered one (if you change your mind on ordering something), doesn't remove the row from the order sheet.

I also would need this to work on a password protected sheet?

I greatly appreciate your help mate, you're an absolute legend!

 

[mumps]

Try this version. Change the password (in red) to suit your needs.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("H:H")) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    ActiveSheet.Unprotect Password:="[COLOR="#FF0000"]MyPassword[/COLOR]"
    Application.ScreenUpdating = False
    Dim ID As Range, desWS As Worksheet
    Set desWS = Sheets("Order Form")
    Set ID = desWS.Range("A:A").Find(Range("A" & Target.Row), LookIn:=xlValues, lookat:=xlWhole)
    If Target <> "" Then
        If Not ID Is Nothing Then
            Target.EntireRow.Copy desWS.Range("A" & ID.Row)
        Else
            Target.EntireRow.Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
    Else
        If Not ID Is Nothing Then
            desWS.Rows(ID.Row).EntireRow.Delete
        End If
    End If
    ActiveSheet.Protect Password:="[COLOR="#FF0000"]MyPassword[/COLOR]"
    Application.ScreenUpdating = True
End Sub

When responding, please click the "Reply" button instead of the "Reply With Quote" button. It keeps things less cluttered. Thanks.