0

Scenario:

I have two worksheets the same except for "some content" in Sheet2 column C-E, 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 C-E 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
Community
  • 1
  • 1
Sean
  • 271
  • 1
  • 8
  • 20
  • 1
    putData doesn't know what Target is. Can you try to pass Target as an argument to putData? Also, i would avoid using selections, check this out http://stackoverflow.com/questions/10714251/excel-macro-avoiding-using-select – Ioannis Sep 04 '13 at 06:30
  • Thanks for that, yes you are right but the actual problem is in getData when trying to reference the source sheet. The problem lies in the statements Worksheets("Sheet2").Select Range(Cells(getRow, getCol), Cells(getRow, getCol)).Select - trying it will show you how it fails. – Sean Sep 04 '13 at 07:49
  • Is `getData` in a module or in `Sheet1`, under the `Worksheet_SelectionChange` sub? If the latter, try to refer to your `Sheet2` objects explicitly, i.e., `Sheet2.Range(Sheet2.Cells(getRow,getCol)....)` (or better a `With ... End With` statement. I *think* (not sure) if you are inside `Sheet1`, all objects are interpreted as of belonging to `Sheet1`, regardless of your selection.. – Ioannis Sep 04 '13 at 07:58
  • Many thanks, Loannis, with your help and another post somewhere I managed to both remove selects and get the data updating the way want. Appreciated, kudos to you. – Sean Sep 04 '13 at 11:14

1 Answers1

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
JosieP
  • 3,360
  • 1
  • 13
  • 16