Sheet duplication, VBA help.

[Newbie212]

Hello

Im trying to duplicate 2 sheets in a workbook. The idea is to have 1 Sheet that is locked and gets its values from references/links, and the other has macro/button that imports and edits info from another file. In the locked sheet there is Data validation column that must be the only editable part of Sheet1.

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Not Intersect(Target, Range("K2:K102")) Is Nothing Then
      If Target.Value = "Verified" Then
         Application.EnableEvents = False
                  Target.Offset(, 1).Resize(, 2).Value = Array(Environ$("Username"), Now)
                  Target.Offset(, -1).Resize(, 4).Locked = True
                           
           Application.EnableEvents = True
         ActiveWorkbook.Save
      End If 
  End If
End Sub

When the user selects Verified from the data validation - the above macro triggers and gets Static value of the username and Date/Time in L and M columns.
So far so good... But i ran into a problem to duplicate the result of data validation in both sheets, if i use reference the macro doesn't work because "=Sheet2!k2"<> "Verified", i tried making loop that goes along K2:K102 range and copy/PasteSpecial as value in Sheet2(The macro is in Sheet2), but the result was ... annoying as you have to wait for it to cycle trough 100 rows. And as the task demands it, this document must be a shared workbook, so i cant use locking/unlocking cells on the fly.

Im rather bad with VBA myself - the macro above was given to me by a awesome MrExceler ,so here i am asking for help/idea. Is there a better way to duplicate K columns? Or can the macro be modified to set Verified in the same address on both sheets?

 

[Kamolga]

Looping through a 100 rows is not so long but saving the workbook can be time consuming
You can use

[COLOR=#333333]Private Sub Worksheet_Change(ByVal Target As Range)
[/COLOR]Application.ScreenUpdating=False
[COLOR=#000000][FONT=Monaco]Application[/FONT][/COLOR][COLOR=#000000][FONT=Monaco].[/FONT][/COLOR][COLOR=#000000][FONT=Monaco]Calculation[/FONT][/COLOR][COLOR=#000000][FONT=Monaco]=[/FONT][/COLOR][COLOR=#000000][FONT=Monaco]xlManual
[/FONT][/COLOR]Application.EnableEvents = False 
If Target.CountLarge > 1 Then Exit Sub
   If Not Intersect(Target, Range("K2:K102")) Is Nothing Then
      If Target.Value = "Verified" Then
                  Target.Offset(, 1).Resize(, 2).Value = Array(Environ$("Username"), Now)
                  Target.Offset(, -1).Resize(, 4).Locked = True
          'ActiveWorkbook.Save
      End If 
  End If
Application.EnableEvents = True
[COLOR=#000000][FONT=inherit]Application[/FONT][/COLOR][COLOR=#000000][FONT=inherit].[/FONT][/COLOR][COLOR=#000000][FONT=inherit]Calculation[/FONT][/COLOR][COLOR=#000000][FONT=inherit]=[/FONT][/COLOR][COLOR=#000000][FONT=inherit]xlAutomatic
[/FONT][/COLOR]Application.ScreenUpdating=true
[COLOR=#333333]End Sub
[/COLOR]

For the locking/unlocking issue, the easiest way is to protect the sheets (on opening event for example) with userinterfaceonly, so for the users the cells are locked but not for the macros.

Private Sub Workbook_Open()
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
    sh.Protect Password:="[COLOR=#ff0000]MySecretPassword"[/COLOR], userinterfaceonly:=true
Next sh
End Sub