title: Data validation and combo box in a cell - Workbook_SheetChange event not working
body: <p>I have adapted the following code from Contextures website which adds combo box functionality into cells containing data validation. Though comboboxes display well where they should, I am still facing two issues.
  First, I would need that after chosing value in "D4" cell, which combines data validation and combo box, the same value was displayed on other sheets in "D4" cell in the workbook. Unfortunately, after comboboxes code was added, the Workbook_SheetChange code stopped working. I assume it is because it cannot find Target in data validation/combobox cell now.
  The second issue is that the Worksheet_SelectionChange code below causes screen flickering even though Application.ScreenUpdating is applied. Is there any way to get rid of it?
  I would be greatful for any solutions.</p>
  
  <p><strong>EDIT:</strong></p>
  
  <p>At last I managed to find solution to first issue myself. I ommited Workbook_SheetChange event entirely and replaced with ComboShtHeader_KeyDown and ComboShtHeader_LostFocus events, both placed in the workbook sheets. These macros ensure that value of a cell changes on all sheets either on pressing Tab, Enter or click outside "D4" cell. I am placing both codes below for the case that someone faces similar issue.</p>
  
  <p>The other issue with screen flickering in Worksheet_SelectionChange code persists though. Solutions are still welcome.:-)</p>
  
  <pre><code>Private Sub ComboShtHeader_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  'change "D4" cell value on all sheets on pressing TAB or ENTER
  
  Dim ws1 As Worksheet, ws As Worksheet
  
  Set ws1 = ActiveSheet
  
  Select Case KeyCode
      Case 9 'Tab
          ActiveCell.Offset(0, 1).Activate
          For Each ws In Worksheets
              If ws.Name &lt;&gt; ws1.Name Then
                  ws.Range(ActiveCell.Offset(0, -3).Address).Value = ActiveCell.Offset(0, -3).Value
              End If
          Next ws
      Case 13 'Enter
          ActiveCell.Offset(1, 0).Activate
          For Each ws In Worksheets
              If ws.Name &lt;&gt; ws1.Name Then
                  ws.Range(ActiveCell.Offset(-1, 0).Address).Value = ActiveCell.Offset(-1, 0).Value
              End If
          Next ws
      Case Else
          'do nothing
  End Select
  
  End Sub
  </code></pre>
  
  <hr>
  
  <pre><code>Private Sub ComboShtHeader_LostFocus()
  'change "D4" cell value on all sheets on click outside "D4" cell 
  
  Dim ws1 As Worksheet, ws As Worksheet
  
  Set ws1 = ActiveSheet
  
  For Each ws In Worksheets
      If ws.Name &lt;&gt; ws1.Name Then
          ws.Range("D4").Value = ws1.Range("D4").Value
      End If
  Next ws
  
  End Sub
  </code></pre>
  
  <hr>
  
  <pre><code>Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  
  Dim ws As Worksheet, ws2 As Worksheet
  Dim ComHead As OLEObject, ComBody As OLEObject
  Dim Str As String
  
  Application.ScreenUpdating = False
  
  On Error GoTo ErrHandler
  Set ws = ActiveSheet
  Set ws2 = Worksheets("lists")
  Set ComHead = ws.OLEObjects("ComboShtHeader")
  Set ComBody = ws.OLEObjects("ComboShtBody")
  
  On Error Resume Next
  If ComHead.Visible = True Then
      With ComHead
        .Top = 34.5
        .Left = 120
        .Width = 20
        .Height = 15
        .ListFillRange = ""
        .LinkedCell = ""
        .Visible = False
        .Value = ""
      End With
  End If
  
  On Error Resume Next
  If ComBody.Visible = True Then
      With ComBody
        .Top = 34.5
        .Left = 146.75
        .Width = 20
        .Height = 15
        .ListFillRange = ""
        .LinkedCell = ""
        .Visible = False
        .Value = ""
      End With
  End If
  
  On Error GoTo ErrHandler
  'If the cell contains a data validation list
  If Target.Validation.Type = 3 Then
      If Target.Address = ws.Range("D4:F4").Address Then
          If Target.Count &gt; 3 Then GoTo ExitHandler
          Application.EnableEvents = False
          'Get the data validation formula
          Str = Target.Validation.Formula1
          Str = Right(Str, Len(Str) - 1)
  
          With ComHead
            'Show the combobox with the validation list
            .Visible = True
            .Left = Target.Left
            .Top = Target.Top
            .Width = Target.Width + 15
            .Height = Target.Height
            .ListFillRange = ws2.Range(Str).Address(external:=True)
            .LinkedCell = Target.Address
          End With
  
          ComHead.Activate
  
          'Open the dropdown list automatically
          Me.ComboShtHeader.DropDown
      Else
          If Target.Count &gt; 1 Then GoTo ExitHandler
          Application.EnableEvents = False
          'Get the data validation formula
          Str = Target.Validation.Formula1
          Str = Right(Str, Len(Str) - 1)
  
          With ComBody
            'Show the combobox with the validation list
            .Visible = True
            .Left = Target.Left
            .Top = Target.Top
            .Width = Target.Width + 15
            .Height = Target.Height
            .ListFillRange = ws2.Range(Str).Address(external:=True)
            .LinkedCell = Target.Address
          End With
  
          ComBody.Activate
  
          'Open the dropdown list automatically
          Me.ComboShtBody.DropDown
      End If
  End If
  
  ExitHandler:
      Application.ScreenUpdating = True
      Application.EnableEvents = True
          Exit Sub
  
  ErrHandler:
      Resume ExitHandler
  
  End Sub
  </code></pre>
  
  <p>The second code, placed in ThisWorkbook module and currently not working:</p>
  
  <pre><code>Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  
  Dim wb1 As Workbook
  Dim ws1 As Worksheet, ws As Worksheet
  
  With Application
      .EnableEvents = False
      .ScreenUpdating = False
  End With
  
  Set wb1 = ThisWorkbook
  Set ws1 = Sh
  
  On Error GoTo LetsContinue
  'This should change "D4" value on all sheets, but does not work after combobox feature was added to the sheets.
  If Not Intersect(Target, ws1.Range("D4")) Is Nothing Then
      MsgBox Target.Address 'returns nothing
      For Each ws In wb1.Worksheets
          If Target.Value &lt;&gt; ws.Range(Target.Address).Value Then
              ws.Range(Target.Address).Value = Target.Value
          End If
      Next ws
  Else
      GoTo LetsContinue
  End If
  
  LetsContinue:
      With Application
          .EnableEvents = True
          .ScreenUpdating = True
      End With
  
  End Sub
  </code></pre>