Excel Comboboxes double up on some PCs

Question

I've got an excel workbook witch uses activeX comboboxes to run VBA code. It works fine on most PCs.

However some of my clients find that when they click on the comboboxes the combobox appears to double up or duplicate, one on top of the other. Also the doubled up drop down doesn't function.

Here's an example (bottom combobox displays the issue):

Here's the code - I'm afraid it calls 3 subroutines which are all quite lengthy:

Private Sub SegmentComboBox_Change()

Call DrawTabCCView
PopTab
Call CCViewAddFormulasNew

End Sub

DrawTabCCView

Sub DrawTabCCView()


Dim C As Range
Dim D As Range
Dim D2 As Range

Dim CountryCol As Integer
Dim SegDetCol As Integer
Dim CompetitionCol As Integer
Dim BrandCol As Integer
Dim CompCol As Integer
Dim TotX As Range, Comp As Range

Dim PrevLabel As String

Application.ScreenUpdating = False

ThisWorkbook.Sheets("Country_Category view").Activate

'clear old data
Set D = ActiveSheet.Range("C13")

If D.Value <> "Total Category" Then Stop

Do Until D.Value = "" And D.End(xlDown) = ""

    Select Case D.Value

    Case "Total Category", "Total", "Private Labels", "Competition"
        PrevLabel = D.Value
        D.EntireRow.ClearContents
        D.Value = PrevLabel

        If D.Value = "Total Category" Then
            Set TotCat = D
        ElseIf D.Value = "Total" Then
            Set TotX = D
        ElseIf D.Value = "Private Labels" Then
            Set PL = D
        ElseIf D.Value = "Competition" Then
            Set Comp = D
        End If




    Case ""

        'do nothing

    Case Else

        If D.Offset(-2, 0) <> "" Then
            D.EntireRow.ClearContents
        Else
            Set D = D.Offset(-1, 0)
            D(2, 1).EntireRow.Delete
        End If

    End Select



    Set D = D.Offset(1, 0)
Loop

Set C = ThisWorkbook.Sheets("Raw Data (2)").Cells(1, 1)

Do Until C.Value = ""

    If C.Value = "Country" Then CountryCol = C.Column
    If C.Value = "Segment + Detail" Then SegDetCol = C.Column
    If C.Value = "Competition" Then CompetitionCol = C.Column
    If C.Value = "Local_Brand_Name" Then BrandCol = C.Column
    If C.Value = "Competition" Then CompCol = C.Column

    Set C = C.Offset(0, 1)
Loop

If CountryCol = 0 Then Stop
If SegDetCol = 0 Then Stop
If CompetitionCol = 0 Then Stop

Set C = C.Parent.Cells(2, 1)
Do Until C.Value = ""
    If C(1, CountryCol).Value = ActiveSheet.CountryComboBox.Value And C(1, SegDetCol).Value = ActiveSheet.SegmentComboBox.Value Then

        Select Case C(1, BrandCol)

        Case "Total Category", "Private Labels", "Total", "Dummy"
            'do nothing
        Case Else

            If C(1, CompCol) = "XXX" Then
                Set D = TotX.Offset(2, 0)
            ElseIf C(1, CompCol) = "Competition" Then
                Set D = Comp.Offset(2, 0)
            Else
                Stop
            End If

            Do Until D.Value = ""
                Set D = D.Offset(1, 0)
            Loop

            If D.Offset(-1, 0).Value <> "" Then
                D.EntireRow.Insert
                Set D = D.Offset(-1, 0)
            End If

            D.Value = C(1, BrandCol).Value

        End Select


    End If
    Set C = C.Offset(1, 0)
Loop



Application.ScreenUpdating = True


End Sub

PopTab

Sub PopTab()

Call PopulateTables(ThisWorkbook.ActiveSheet)
ActiveSheet.Range("A1").Activate

End Sub

CCViewAddFormulasNew

Sub CCViewAddFormulasNew()

Dim D As Range
Dim D2 As Range
Dim TabFilter(1 To 2, 4) As Variant


TabFilter(1, 0) = "Measure"
TabFilter(1, 1) = "Country"
TabFilter(1, 2) = "Segment + Detail"
TabFilter(1, 3) = "Period"
TabFilter(1, 4) = "Local_Brand_Name"

TabFilter(2, 0) = "XXX"
TabFilter(2, 1) = ActiveSheet.CountryComboBox.Value
TabFilter(2, 2) = ActiveSheet.SegmentComboBox.Value
TabFilter(2, 3) = "XXX"
TabFilter(2, 4) = "XXX"


Application.ScreenUpdating = False
If DontUpdate = False Then
    'Stop

    Set D = ThisWorkbook.Sheets("Country_Category view").Range("C13")

    Do Until D.Value = "" And D.End(xlDown).Value = ""
        If D.Value <> "" Then
            Set D2 = D(1, 3)

            'brand
            TabFilter(2, 4) = D.Value


            Do Until D2.Parent.Cells(11, D2.Column) = "" And D2.Parent.Cells(11, D2.Column + 1) = ""

                    TabFilter(1, 0) = D2.Parent.Cells(10, D2.Column).Value

                    TabFilter(2, 3) = D2.Parent.Cells(11, D2.Column).Value
                    D2.Value = FindValPivot(ThisWorkbook.Sheets("Raw Data"), TabFilter())

                    TabFilter(2, 3) = D2.Parent.Cells(11, D2.Column + 1).Value
                    D2(1, 2).Value = FindValPivot(ThisWorkbook.Sheets("Raw Data"), TabFilter())

                    If D2.Value <> "" And D2(1, 2).Value <> "" Then
                        D2(1, 3).FormulaR1C1 = "=RC[-1]/RC[-2] * 100"
                    End If

                    If IsError(D2(1, 3).Value) Then D2(1, 3).Value = "n/a"

                Set D2 = D2.Offset(0, 4)
            Loop
        End If

        Set D = D.Offset(1, 0)
    Loop

End If

Application.ScreenUpdating = True

ActiveSheet.Range("A1").Activate

End Sub

Any idea how to stop this happening?

Cheers!

Answer 1

For the sake of completeness here is the solution that worked for me. I adapted the code from enderland.

As noted in comments by @Oliver Humphreys, this seems to be related to differing screen resolutions. I tested on a number of different machines, with different versions of Excel, using the following cmd command to verify test machines screen dimensions.

wmic desktopmonitor get screenheight, screenwidth

The machines with the same dimensions showed no problem with the ActiveX double-image. Those with differing dimensions did, irrespective of Excel version or 32/64 bit.

I have adapted the source code to loop each sheet and write out the settings of each ActiveX object, to a text file, with a space in between each object's details.

I put this code in a standard module, on the development machine I use, and ran it from there. You could in theory run this on individual machines, where you create an ActiveX object of particular dimensions, and then use those dimensions.

I then used the output information to set up Workbook_Open event. In this event I set the properties for all the ActiveX controls. And voilà, no more double image and the object functions as expected. Users versions had only the Workbook_Open Code in.

The reason for leaving the Workbook_Open code in the distributed workbooks is in case of onward distribution.

Code to get existing dimensions:

Option Explicit

Private Sub printAllActiveXSizeInformation()

    Dim myWS As Worksheet
    Dim OLEobj As OLEObject
    Dim obName As String
    Dim shName As String
    Dim mFile As String
    mFile = "C:\Users\yourusername\Desktop\ActiveXInfo.txt"

    Open mFile For Output As #1


    For Each myWS In ThisWorkbook.Worksheets

        shName = myWS.Name

        With myWS

            For Each OLEobj In myWS.OLEObjects

                obName = OLEobj.Name

                Print #1, "'" + obName
                Print #1, shName + "." + obName + ".Left=" + CStr(OLEobj.Left)
                Print #1, shName + "." + obName + ".Width=" + CStr(OLEobj.Width)
                Print #1, shName + "." + obName + ".Height=" + CStr(OLEobj.Height)
                Print #1, shName + "." + obName + ".Top=" + CStr(OLEobj.Top)
                Print #1, "ActiveSheet.Shapes(""" + obName + """).ScaleHeight 1.25, msoFalse, msoScaleFromTopLeft"
                Print #1, "ActiveSheet.Shapes(""" + obName + """).ScaleHeight 0.8, msoFalse, msoScaleFromTopLeft"
                Print #1, vbNewLine

            Next OLEobj

        End With

    Next myWS

    Close #1

    Shell "NotePad " + mFile

End Sub

Example Workbook_Open event code:

Private Sub Workbook_Open()

    Dim wb As Workbook
    Dim ws as Worksheet
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet1")  'add more as appropriate

    With ws

      .OLEObjects("ComboBox1").Left = 269
      .OLEObjects("ComboBox1").Width = 173
      .OLEObjects("ComboBox1").Height = 52.5
      .OLEObjects("ComboBox1").Top = 179.5
      .Shapes("ComboBox1").ScaleHeight 1.25, msoFalse, msoScaleFromTopLeft

    End With

End Sub

---

Alternatively, switch to form controls.