Insert cut row in protected range of rows

[a_27826]

I need help.

I need a VBA code to automatically insert cut paste a row from a range of unprotected rows to the range of protected rows once the user decides to do so.

I have two sheets called “Customer Stock” and “Collected Stock”.

I need “Customer Stock” sheet to be unprotected and “Collected” sheet to be protected.

Once the a Customer collects the goods, the user can move the collected row from the unprotected “Customer Stock” sheet to just above the first row of the protected “Collected” sheet.

so that the moved row now should be protected.

The password should be a27826 and the user won’t know the password. Only the administrator will be having it.

 

[Abhijeet R. Joshi]

Since I could not find any Collected Data table, I created similar sheet myself and below is the VBA code for the same.
So what the VBA does here is, it will ask a confirmation window and then will copy data from activecell (currently selected cell) in the Uncollected table and paste them in the Collected Sheet, however the Collected Data Sheet still remains protected after the completion of the code.

So basically for the customer you have to copy the data, just select any data of that customer and then run the below code..
This will keep adding the data below the one already available and not on the top.

Let me know if this helps...

Sub Customer_Stock()
Dim drc, dx As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False
response = MsgBox("Are you sure you want to move the data for current Customer to Collected Data Table?", vbYesNo)
If response <> 6 Then
MsgBox "No data moved!!"
Exit Sub
Else

Worksheets("Collected Data").Unprotect Password:="1234" ' change the password to whatever you wish
Sheets("Customer Stock").Select
dx = ActiveCell.Row
Rows(dx).select
selection.cut
Sheets("Collected Data").Select
drc = Range("A" & Application.Rows.Count).End(xlUp).Row + 1
Rows(drc).Select
ActiveSheet.Paste
Columns.AutoFit
Range("A1").Select
Worksheets("Collected Data").Protect Password:="1234" ' change the password to whatever you wish
Sheets("Customer Stock").Select
icstmr = Worksheets("Customer Stock").Cells(dx, 2).Value
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox icstmr & " data has been moved to Collected Sheet"
End If
End Sub

 

[a_27826]

A million thanx, Abhijeet.

It works magically.

Will i be asking too much if you can make it more magical ?

1. Moving certain rows (eg R15,R18 and R22) from Customer Stock to Collected Stock instead of moving one row at a time.

2.The moved rows be placed on the top instead on the bottom.

NOTE: new password is a27826

Sub Customer_Stock()
Dim drc, dx As Long
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
response = MsgBox("Are you sure you want to move the selected row from Customer Stock to Collected Stock?", vbYesNo)
If response <> 6 Then
MsgBox "No row moved!!"
Exit Sub
Else
 
Worksheets("Collected Stock").Unprotect Password:="a27826" ' change the password to whatever you wish
Sheets("Customer Stock").Select
dx = ActiveCell.Row
Rows(dx).Select
Selection.Cut
Sheets("Collected Stock").Select
drc = Range("A" & Application.Rows.Count).End(xlUp).Row + 1
Rows(drc).Select
ActiveSheet.Paste
Columns.AutoFit
Range("A1").Select
Worksheets("Collected Stock").Protect Password:="a27826" ' change the password to whatever you wish
Sheets("Customer Stock").Select
icstmr = Worksheets("Customer Stock").Cells(dx, 2).Value
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox icstmr & " the selected row has been moved to Collected Stock"
End If
End Sub

 

[Abhijeet R. Joshi]

I am glad that it worked.
So for the improvisation part, do you mean you only want to move specific cells and not the whole row?
I can put the rows at the top for you, once you have an answer to my above question so that I can post the whole coding in one go..

Thanks,
Abhi

Changes are Eternal, we have to learn to deal with it !!!

 

[a_27826]

I am glad that it worked.
So for the improvisation part, do you mean you only want to move specific cells and not the whole row?
I can put the rows at the top for you, once you have an answer to my above question so that I can post the whole coding in one go..

Thanks,
Abhi

Hi,

i mean i want to select certain whole rows and move them in one go, rather than moving one row at a time