Question

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.

EDIT:

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.

The other issue with screen flickering in Worksheet_SelectionChange code persists though. Solutions are still welcome.:-)

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 <> 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 <> 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

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 <> ws1.Name Then
        ws.Range("D4").Value = ws1.Range("D4").Value
    End If
Next ws

End Sub

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 > 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 > 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

The second code, placed in ThisWorkbook module and currently not working:

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 <> 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

No correct solution

OTHER TIPS

Actually, the second issue that regarded screen flickering solved itself when I moved from Excel 2007 to 2013 version. It seems like some kind of bug in older version.

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top