excel Worksheet_SelectionChange - copying data

Question

Scenario :

I have two worksheets the same except for "some content" in Sheet2 column CE, and Sheet1 containing a Worksheet_SelectionChange handler

When I click on column B in Sheet1 the Worksheet_SelectionChange changes the cell colour and then sets column CE to that of Sheet2 Column C

Problem :

Trouble is it falls over on an application error...

Can anyone help please, this is really annoying...just how do i copy the data from Sheet2 to Sheet 1 in a Worksheet_SelectionChange handler?

If I set S1C = "X" (as in hardcoded it's fine), its when I try to reference the cell from the second sheet that it doesn't work.

many thanks in advance, Best regards

Code as follows:

Public benRel
Public rskOpt
Public resOpt
Public getRow
Public getCol

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

On Error GoTo ExitSubCorrectly
'turn off multiple recurring changes
Application.EnableEvents = False

'do not allow range selection
If Target.Cells.Count > 1 Then GoTo ExitSubCorrectly


'only allow selection within our range
Set myRange = Range("B8:B24")
If Not Application.Intersect(Target, myRange) Is Nothing Then
    ' At least one cell of Target is within the range myRange.
    ' Carry out some action.

    getRow = Target.Row
    getCol = Target.Column


    Select Case Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Style

        Case "Normal"
            Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Style = "Accent1"

            getData
            putData

        Case "Accent1"
            Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Style = "Normal"
            Range(Cells(Target.Row, Target.Column + 1), Cells(Target.Row, Target.Column + 3)).Value = ""

        Case Else

    End Select

Else
    ' No cell of Target in in the range. Get Out.
    GoTo ExitSubCorrectly
End If

ExitSubCorrectly:
' go back and turn on changes
' MsgBox Err.Description
Worksheets("Sheet1").Select
Application.EnableEvents = True

End Sub

Sub getData()

Worksheets("Sheet2").Select
Range(Cells(getRow, getCol), Cells(getRow, getCol)).Select
benRel = Range(Cells(getRow, getCol), Cells(getRow, getCol)).Offset(0, 1).Value
rskOpt = Range(Cells(getRow, getCol), Cells(getRow, getCol)).Offset(0, 2).Value
resOpt = Range(Cells(getRow, getCol), Cells(getRow, getCol)).Offset(0, 3).Value


End Sub

Sub putData()

Worksheets("Sheet1").Select
Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Offset(0, 1).Value = benRel
Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Offset(0, 2).Value = rskOpt
Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Offset(0, 3).Value = resOpt

End Sub

Answer 1

it looks to me like you could replace all three routines with

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

   On Error GoTo ExitSubCorrectly
   'turn off multiple recurring changes
   Application.EnableEvents = False

   'do not allow range selection
   If Target.Cells.Count > 1 Then GoTo ExitSubCorrectly

   'only allow selection within our range
   Set myRange = Range("B8:B24")
   If Not Application.Intersect(Target, myRange) Is Nothing Then
      ' At least one cell of Target is within the range myRange.
      ' Carry out some action.
      With Cells(Target.Row, Target.Column)
         Select Case .Style

            Case "Normal"
               .Style = "Accent1"
               .Offset(0, 1).Resize(, 3).Value = Worksheets("Sheet2").Cells(getRow, getCol).Offset(0, 1).Resize(, 3).Value
            Case "Accent1"
               .Style = "Normal"
               .Offset(0, 1).Resize(, 3).ClearContents
            Case Else

         End Select
      End With

   End If

ExitSubCorrectly:
   ' go back and turn on changes
   ' MsgBox Err.Description
   Application.EnableEvents = True

End Sub