View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Tom Ogilvy Tom Ogilvy is offline
external usenet poster
 
Posts: 27,285
Default Devious multiplying Forms DropDowns

I have a line in the next routine that removes all existing dropdowns on the
active sheet. I have it commented out, but my approach would be to always
create them from scratch. So I recommend uncommenting that line.

Sub DropDowns_Create()
'
' DropDown_Create Macro
' Macro recorded 08/11/2003 by Darren
' MyCell = the cell in which the

Dim myRow As Long
Dim myColumn As String
Dim strDropDown As String
Dim myLinkCell As String
Dim myLinkString As String
Dim myCounter As Integer
Dim rng As Range

' Uncomment to remove all dropdowns
'ActiveSheet.DropDowns.Delete

myColumn = "E"
myLinkCell = "AP"
For myRow = 5 To 24
Set rng = ActiveSheet.Cells(myRow, myColumn)
With ActiveSheet.DropDowns.Add(Left:=rng.Left, _
Top:=rng.Top, Width:=rng.Width, _
Height:=rng.Height)
strDropDown = "Drop Down " & myColumn & myRow
myLinkString = myLinkCell & myRow
.Name = strDropDown
.PrintObject = False
.ListFillRange = ActiveSheet.Range("BO5:BO24") _
.Address(external:=True)
.LinkedCell = ActiveSheet.Range(myLinkString) _
.Address(external:=True)
.DropDownLines = 8
.Display3DShading = False
End With
Next
End Sub

Is there a way to cycle through the drop downs, and remove any which

aren't
named in the format:
"Drop Down [RC]" with [RC] = the address of the cell containing the Drop
Down, example: "A5". (So, I'd need to identify the cell that the DD is
currently hovering over, and then check to see that it's name matches that
cell.)


You probably don't need it if you delete all the dropdowns and add new using
the above:

Sub RemoveDropDowns()
Dim drpdwn As DropDown
Dim sName As String
Dim sCell As String
Dim iloc As Long
Dim rng As Range
For Each drpdwn In ActiveSheet.DropDowns
sName = Trim(drpdwn.Name)
sCell = sName
iloc = 0
Do While InStr(sCell, " ")
iloc = InStr(sCell, " ")
sCell = Right(sCell, Len(sCell) - iloc)
Loop
Set rng = Nothing
On Error Resume Next
Set rng = ActiveSheet.Range(sCell)
On Error GoTo 0
If Not rng Is Nothing Then
If drpdwn.TopLeftCell.Address(0, 0) < sCell Then
drpdwn.Delete
End If
Else
drpdwn.Delete
End If
Next
End Sub


--
Regards,
Tom Ogilvy

Darren Hill wrote in message
...
Hi Tom, you wrote:
"I haven't heard of this. Are you sure it didn't occur when you were
creating them."

Actually, it was a silly mistake on my part - I copied a cell containing a
drop down to paste it's formula into other cells, so the drop down was
copied too.

Is there a way to cycle through the drop downs, and remove any which

aren't
named in the format:
"Drop Down [RC]" with [RC] = the address of the cell containing the Drop
Down, example: "A5". (So, I'd need to identify the cell that the DD is
currently hovering over, and then check to see that it's name matches that
cell.)


As to your other question, yes I would be interested in seeing more code

for
creating drop downs. After playing with the macro recorder, I did come up
with the first macro below to create them, but I am keen to be shown how

to
clean it up (getting rid of the select, for example). The second macro was
provided by Vasant Nanavati, which enables me to position the created
macros.


Sub DropDowns_Create()
'
' DropDown_Create Macro
' Macro recorded 08/11/2003 by Darren
' MyCell = the cell in which the

Dim myRow As Integer
Dim myColumn As String
Dim strDropDown As String
Dim myLinkCell As String
Dim myLinkString As String
Dim myCounter As Integer

myColumn = "E"
myLinkCell = "AP"

For myRow = 5 To 24
ActiveSheet.DropDowns.Add(209.25, 88.5, 66.75, 15.75).Select
strDropDown = "Drop Down " & myColumn & myRow
myLinkString = "$" & myLinkCell & "$" & myRow
With Selection
.Name = strDropDown
.PrintObject = False
'.ListFillRange = "$BO$5:$BO$24"
.LinkedCell = myLinkString
.DropDownLines = 8
.Display3DShading = False
End With
Next
End Sub

Sub DropDowns_Resize()

Dim drp As DropDown, iLen As Long
For Each drp In ActiveSheet.DropDowns
With drp
iLen = Len(drp.Name) - InStr(1, drp.Name, "n ") - 1
.Left = Range(Right(drp.Name, iLen)).Left
.Top = Range(Right(drp.Name, iLen)).Top
.Height = Range(Right(drp.Name, iLen)).Height
.Width = Range(Right(drp.Name, iLen)).Width
End With
Next
End Sub
--
Darren

"Tom Ogilvy" wrote in message
...
Hello Darren,

I haven't heard of this. Are you sure it didn't occur when you were
creating them.

Perhaps you created them by copying one and then editing the linked cell

on
the copy. When you pasted, it is not hard to repeat the action without
noticing. Perhaps you pasted, edited the link and then inadvertently

did
another paste on top.

If I was going to add a lot of Drop Downs, I think I would do it with

code
as the positioning and sizing can be done a lot more accurately.

Post back with some details if you want to see an example.

--
Regards,
Tom Ogilvy


Darren Hill wrote in message
...
I've noticed that, when I have a large number of Forms Drop Downs,

fairly
often one or more of them seem to decide to copy themselves over other

drop
downs. When I click on the new copies, I notice that it is changing

the
wrong linked cells, and discover it is a copy.

Does anyone know why this happens? Maybe there's a shortcut for

copying
these things that I'm inadvertently typing.

Darren