VBA unable to copy and paste with selectionChange &unlocking/locking worksheet

luckVIII

New Member
Joined
Sep 18, 2018
Messages
4
Hi Everyone,
I am having problems copy from a different workbook into my current workbook. I can copy but i can't paste even within the same workbook. I've isolated down to my coding with Private Sub Worksheet_SelectionChange(ByVal Target As Range). I suspect it has something with me unlocking and locking the worksheet. I am aware my coding isn't clean but right now I am focusing on the copy paste issue. I know its something fundamental that I need understanding. Thanks again

B


code

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    


'  If Target.Address = "$M$55" Then
'    ActiveWindow.Zoom = 100
'  Else
'    ActiveWindow.Zoom = 100
'  End If
'   On Error GoTo LZoom
'    Dim xZoom As Long
'    xZoom = 40
'    If Target.Validation.Type = xlValidateList Then xZoom = 130
'LZoom:
'    ActiveWindow.Zoom = xZoom
score5 = Range("D48").Value
score6 = Range("D49").Value
score7 = Range("D54").Value
score8 = Range("D55").Value
Range("I49").ClearContents
Range("I50").ClearContents
Range("I55").ClearContents
Range("I56").ClearContents




Sheets("Final").Unprotect Password:="bob"
Range("R49").Value = ""
Range("R50").Value = ""
Range("R55").Value = ""
Range("R56").Value = ""


If IsNumeric(Range("D48")) = True Then
'Range("I50").Value = ""
'    Range("I49").Value = ""
If score5 >= 2 And score6 >= 4 Then
    Range("I50").Value = "Positive"
    Range("I49").Value = "Group 1"
'    result1 = "Positive"
    Range("I50").Font.Color = -16776961


ElseIf score5 < 2 And score6 < 4 Then
    Range("I50").Value = "Negative"
    Range("I49").Value = "Group 5"
'    result1 = "Negative"
    Range("I50").Font.Color = RGB(0, 128, 0)


'ElseIf IsEmpty(Range("M49")) Then
'    Range("I49").Value = "Pending with IHC"
'    MsgBox "Please enter info in IHC box"


'ElseIf IsEmpty(Range("B3")) Then
'    MsgBox "Please enter values for HER2 and CEP17"


'ElseIf IsEmpty(Range("C3")) Then
'    MsgBox "Please enter values for HER2 and CEP17"
'MsgBox "Prompt before logic test"
'If score1 >= 2 And score2 < 4 And (Range("A3").Value = "0+" Or Range("A3").Value = "1+" Or Range("A3").Value = "2+") Then


ElseIf score5 >= 2 And score6 < 4 Then
    Range("I49").Value = "Group 2"
    Range("I50").Value = "IHC Pending"
'    Range("D3").Value = "Group 2"
'    result1 = "Negative*"
'    Range("R50").Font.Color = RGB(0, 128, 0)


'ElseIf score5 >= 2 And score6 < 4 And Range("M49").Value = "3+" Then
'    Group1 = "Group 2"
'    result1 = "Positive"
'    Range("R50").Font.Color = -16776961


ElseIf score5 < 2 And score6 >= 6 Then
    Range("I49").Value = "Group 3"
    Range("I50").Value = "IHC Pending"
'    result1 = "Negative*"
'    Range("R50").Font.Color = RGB(0, 128, 0)


'ElseIf score5 < 2 And score6 >= 6 And (Range("M49").Value = "2+" Or Range("M49").Value = "3+") Then
'    Group1 = "Group 3"
'    result1 = "Positive"
'    Range("R50").Font.Color = -16776961


ElseIf score5 < 2 And score6 >= 4 And score6 < 6 Then
    Range("I49").Value = "Group 4"
    Range("I50").Value = "IHC Pending"
'    result1 = "Negative*"
'    Range("R50").Font.Color = RGB(0, 128, 0)


'ElseIf score5 < 2 And score6 >= 4 And score6 < 6 And Range("M49").Value = "3+" Then
'    Group1 = "Group 4"
'    result1 = "Positive"
'    Range("R50").Font.Color = -16776961
'ElseIf Range("M49").Value = "N/A" Then
'    Range("I49") = "Pending with IHC"
Else:
   MsgBox "Error"




   


    End If
End If
If score7 > 0 And score8 > 0 Then
Range("I55").Value = "Positive"
Range("I56").Value = "Group 1"


    If score7 >= 2 And score8 >= 4 Then
        Range("I56").Value = "Positive"
        Range("I55").Value = "Group 1"
'        result2 = "Positive"
        Range("I56").Font.Color = -16776961
    
    ElseIf score7 < 2 And score8 < 4 Then
        Range("I56").Value = "Negative"
        Range("I55").Value = "Group 5"
'        result2 = "Negative"
        Range("I56").Font.Color = RGB(0, 128, 0)


'    ElseIf IsEmpty(Range("M55")) Then
'        Range("I55").Value = "Pending with IHC"
'        MsgBox "Please enter info in IHC box"


    'ElseIf IsEmpty(Range("B3")) Then
    '    MsgBox "Please enter values for HER2 and CEP17"


    'ElseIf IsEmpty(Range("C3")) Then
    '    MsgBox "Please enter values for HER2 and CEP17"
    'MsgBox "Prompt before logic test"
    'If score1 >= 2 And score2 < 4 And (Range("A3").Value = "0+" Or Range("A3").Value = "1+" Or Range("A3").Value = "2+") Then


    ElseIf score7 >= 2 And score8 < 4 Then
        Range("I55").Value = "Group 2"
        Range("I56").Value = "IHC Pending"
    '    Range("D3").Value = "Group 2"
    '    result2 = "Negative*"
    '    Range("R56").Font.Color = RGB(0, 128, 0)


'    ElseIf score7 >= 2 And score8 < 4 And Range("M55").Value = "3+" Then
'        Group2 = "Group 2"
'        result2 = "Positive"
'        Range("R56").Font.Color = -16776961


    ElseIf score7 < 2 And score8 >= 6 Then
        Range("I55").Value = "Group 3"
        Range("I56").Value = "IHC Pending"
'        result2 = "Negative*"
'        Range("R56").Font.Color = RGB(0, 128, 0)


'    ElseIf score7 < 2 And score8 >= 6 And (Range("M55").Value = "2+" Or Range("M55").Value = "3+") Then
'        Group2 = "Group 3"
'        result2 = "Positive"
'        Range("R56").Font.Color = -16776961


    ElseIf score7 < 2 And score8 >= 4 And score8 < 6 Then
        Range("I55").Value = "Group 4"
        Range("I56").Value = "IHC Pending"
'        result2 = "Negative*"
'        Range("R56").Font.Color = RGB(0, 128, 0)


'    ElseIf score7 < 2 And score8 >= 4 And score8 < 6 And Range("M55").Value = "3+" Then
'        Group2 = "Group 4"
'        result2 = "Positive"
'        Range("R56").Font.Color = -16776961
    
'    ElseIf Range("M55").Value = "N/A" Then
'        Range("I55") = "Pending with IHC"
    Else:
    MsgBox "Error 2"


    End If
    
    
  End If
   
   If ActiveCell.Address = "$C$4" Then
       Application.OnKey "{ENTER}", "Right"
   End If
   If ActiveCell.Address = "$L$4" Then
      Right
   End If
   If ActiveCell.Address = "$M$4" Then
       Application.OnKey "{ENTER}", "Right"
   End If
   If ActiveCell.Address = "$S$4" Then
       Range("D12").Select
   End If
   If ActiveCell.Row > 11 And ActiveCell.Row < 32 Then
       If ActiveCell.Column = 4 Or ActiveCell.Column = 10 Or ActiveCell.Column = 16 Then
        Application.OnKey "~", "Right"
        Application.OnKey "{ENTER}", "Right"
       End If
       If ActiveCell.Column = 5 Or ActiveCell.Column = 11 Or ActiveCell.Column = 17 Then
        Application.OnKey "~", "Reset"
        Application.OnKey "{ENTER}", "Reset"
       End If
   End If
   If ActiveCell.Row = 32 Then
       ActiveCell.Offset(3, 0).Select
   End If
   If ActiveCell.Row = 35 Then
       Application.OnKey "~", "ResetTech"
       Application.OnKey "{ENTER}", "ResetTech"
   End If
   If ActiveCell.Address = "$V$12" Then
       Range("C59").Select
   End If
Sheets("Final").Protect Password:="bob"
End Sub
 
Last edited by a moderator:

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
I suspect it has something with me unlocking and locking the worksheet

Prove or disprove your theory
1: comment out (or delete) the lines that protect\unprotect
2: remove sheet protection manually
3: run your code

If it now does what you want then you are correct, otherwise the problem is elsewhere in your code
 
Upvote 0
Thanks Yongle,
So I commented out protect\unprotect

Also had to commented out
Range("I50").Font.Color = RGB(0, 128, 0)

Then commented out Range("I49").ClearContents
Range("I50").ClearContents
Range("I55").ClearContents
Range("I56").ClearContents
Then the program can copy and paste.

I want Cell I49, I50, I55, and I56 to clear each time user enter data in data field so that if user wipes all data in data field there shouldn't be any text in Cell I49, I50, I55 and I56

I am totally a newbie so I will appreciate any feedback
Thanks again
B
 
Upvote 0
You have put yourself in an infinite loop and that is why nothing is happening

Every time a different cell is selected Worksheet_SelectionChange runs doing all the things you have told it to do.
Select a different cell and off it goes again...The code is running every line of code and applying all those rules every time a different cell is selected.
There are lots of other issues too

My advice - start again from scratch with your code and ask for help building it one segment at a time and learn as you go.
I am sorry if you feel like this :oops:
 
Upvote 0
Thanks Yongle,

It wasn't what I wanted to hear but it probably what i needed to know. Sorry it took time to get back but I was testing some possible solutions that didn't pan out. I will repost specific question since I now have a simpler solution but need some guidance.
Truly Appreciative
B
 
Upvote 0

Forum statistics

Threads
1,213,522
Messages
6,114,112
Members
448,549
Latest member
brianhfield

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top