Extended DataValidation Dropdown Listbox - Object Creation/Inherit

[phillfri]

I'm a casual user of VBA and in this case I think I've got an issue that I
just don't have enough knowledge to address. So here I am asking for some
help.

I'm attempting to implement some VBA code that extends the width of a data
validation list's dropdown listbox. Credit for the original code goes to
Colo's Excel Junk room, at http://puremis.net/excel/code/068.shtml. My
version is very slightly modified.

I can get the code to work, albeit it seems a bit unstable if I don't delete
and re-create my data validation definitions on closing and opeing the
workbook. But my problem is that sometimes the way Excel acts with the data
validation dropdown box just changes, and it can't be changed back to working
correctly without reconstructing the workbook from scratch.

As one moves across an Excel row, the extended datavalidation listbox
routine gets run in the worksheet_selectionchange procedure if a cell has a
datavalidation object attached to it. Normally, when the program returns from
the extended data validation listbox routine one sees what the dropdown icon
next to the activecell, and if you click on the dropdown the dropdown listbox
itself will be the width in points that I allocate to it. Now the cell is
ready for input. If I make a selection from the dropdown list, the cell will
be updated and I can also make other updates to other cells in the active
Excel row based on the selection made in the dropdown listbox (using the
worksheet_change procedure). This will work fine, perhaps for several days.

But then, all of a sudden, when I try to update ANY cell on the active Excel
row from an entry made with the data validation dropdown listbox, the program
aborts with a 1004 error message (Application defined or object defined
error). Mind you, I can still edit the data validation cell directly and
Excel will allow updates to the row. But no update from the extended data
validation dropdown listbox. Also, if I put cell "updating" code into the
worksheet_selection change procedure of the next cell in the row, Excel will
allow updating to other cells in the row. Its as if the data validation drop
down list receives the focus/acts as an acti ve application and Excel can't
do anything again until I click on the Excel interface to reactivate the
Excel application. So I've got to believe that this problem has something to
do with the extended datavalidation listbox routine and how it's manipulating
the datavalidation listbox.

If anyone has any suggestions I'm all ears. Any help or suggestions would be
appreciated. I've included the pertinent code below:

=====================
Sub MakeValidationWidthWide(ByVal Target As Range, Optional DesiredWidth)
'This procedure widens Data Validation dropdown listboxes. It never
'lets the width of the Data Validation dropdown listbox be made
'shorter than the width of the cell to which the Data Validation
'object is attached.
'
'Parameters:
' Target A single cell range
' DesiredWidth The desired width of the data validation
' dropdown list box in points.
'
Dim wks As Worksheet
Dim elmDic As Object
Dim elmShp As Shape
Dim drpShp As Shape
Dim objDic As Object
Dim currentFilterRange As String
Dim FilterArray()
Dim AutoFilterFlag As Boolean
Dim f As Integer
Dim Col As Integer
Dim RelativeToOriginalSize As Double 'a ratio relative to
original width

'Invoke error trapping
10 On Error GoTo MakeValidationWidthWide_Error

20 Set wks = Target.Parent
30 On Error GoTo Terminate
40 If Target.Cells.Count > 1 Then Exit Sub
50 If Target.Validation.Type = xlValidateList Then

'Save worksheet autofilter settings - This approach will not
work if
'the worksheet is utilizing an autofilter. Check for
autofilter and
'save settings if autofilter is on. Restore the settings later.
60 If wks.AutoFilterMode = True Then
70 AutoFilterFlag = True
80 With wks.AutoFilter
90 currentFilterRange = .Range.Address
100 With .Filters
110 ReDim FilterArray(1 To .Count, 1 To 3)
120 For f = 1 To .Count
130 With .Item(f)
140 If .On Then
150 FilterArray(f, 1) = .Criteria1
160 If .Operator Then
170 FilterArray(f, 2) = .Operator
180 FilterArray(f, 3) = .Criteria2
190 End If
200 End If
210 End With
220 Next
230 End With
240 End With
250 wks.AutoFilterMode = False
260 End If

'Caluculate the RelativeToOriginalSize ratio
270 If IsMissing(DesiredWidth) Then
280 RelativeToOriginalSize = 1
290 Else
300 If DesiredWidth > (Target.Width + 10.25) Then
310 RelativeToOriginalSize = DesiredWidth / (Target.Width
+ 10.25)
320 Else
330 RelativeToOriginalSize = 1
340 End If
350 End If

'Create the Dictionary Object and enter DataValidation dropdown
'object into the Dictionary
360 Set objDic = CreateObject("Scripting.Dictionary")
370 For Each elmDic In wks.DrawingObjects
380 objDic.Add elmDic.Name, elmDic.Name
390 Next
400 For Each elmShp In wks.Shapes
410 If elmShp.Name Like "Drop Down *" Then
420 If Not objDic.Exists(elmShp.Name) Then
430 Set drpShp = elmShp
440 Exit For
450 End If
460 End If
470 Next

'Resize the Dictionary Object DataValidation dropdown listbox
480 If Not drpShp Is Nothing Then
'Adjust top for Excel rows with a height less than 15
490 If Target.Height < 15 Then drpShp.IncrementTop - 4.5
'Proportionally resize the DataValidation Object
500 drpShp.ScaleWidth RelativeToOriginalSize, False,
msoScaleFromBottomRight
'SendKeys "%{down}"
510 End If

'Restore worksheet autofilter settings
520 If AutoFilterFlag Then
530 wks.Range(currentFilterRange).AutoFilter
540 For Col = 1 To UBound(FilterArray(), 1)
550 If Not IsEmpty(FilterArray(Col, 1)) Then
560 If FilterArray(Col, 2) Then
570 wks.Range(currentFilterRange).AutoFilter
field:=Col, _
Criteria1:=FilterArray(Col, 1), _
Operator:=FilterArray(Col, 2), _
Criteria2:=FilterArray(Col, 3)
580 Else
590 wks.Range(currentFilterRange).AutoFilter
field:=Col, _
Criteria1:=FilterArray(Col, 1)
600 End If
610 End If
620 Next
630 End If

640 End If

Terminate:
650 Set wks = Nothing
660 Set drpShp = Nothing
670 Set objDic = Nothing
680 On Error GoTo 0
690 Exit Sub

MakeValidationWidthWide_Error:
700 MsgBox "Error! Line: " & Erl & " No: " & Err.Number & " (" &
Err.Description & ") in procedure MakeValidationWidthWide of Module
modTimeTrack"
710 GoTo Terminate

End Sub

 

[phillfri]

Update:

Further research on the internet indicates that this problem may not have
anything to do with the extended dropdown code I've posted, but rather may
well be a bug in the general data validation dropdown code in Excel (or more
precisely forms handling code).

I've come across several posts about problems with updating an Excel sheet
from the worksheet_change event when utilizing a data validation dropdown
listbox as the source of a cell's data. In these cases the underlying
symptoms are the same as mine, except I probably have an added layer of
results due to the manipulation of the width of the data validation dropdown
listbox. In any event, the cases I found always end end up with the worksheet
in question being unrecoverable.

The code involved can be copied to a new worksheet, and it will work just
fine - but it never works again in the original worksheet. Additionally, if
you simultaneously open the old corrupted sheet while the new uncorrupted
sheet is open, the new uncorrupted worksheet will stop working. Once you
close the old corrupted worksheet, the new uncorrupted worksheet will start
working again. This makes me think that that whatever settings are causing
this affect are in fact being maintained in a 'common area' outside of Excel
itself, somewhere else within the operating system memory or module storage.
I'm tending to think there is a problem here in the Excel interface with
Windows vis-a-vis handling dialog forms and/or their constituent components.

Similar problems have been noted by individuals utilizing several forms in
an Excel workbook.