Thread: Close drop box
View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
GTVT06 GTVT06 is offline
external usenet poster
 
Posts: 141
Default Close drop box

On Jan 12, 1:11*pm, Joanne wrote:
WIN XP Pro MSOffice 2003
I am using the following code to auto drop my dropbox on entering the
cell. It works well to drop the box, but then after the user makes a
choice, the box will not close and allow us to move to the next cell.

Could someone tell me what is missing here?
BTW, kudos to GTVT06, who gave me this code in answer to my earlier SOS
on this forum.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Column = 8 Then
ActiveCell.Offset(1, -6).Select
End If
On Error GoTo Endw
If ActiveCell.Validation.Type = 3 Then
* *With Selection
* *SendKeys "%{down}"
* End With
* End If
Endw:
End Sub

Thank you
Joanne


Hey Joanne, me again. =D I think the adjustment would actually have to
be made on the other part of your code. adjust your Worksheet_Change
code to this and see if that works:

Private Sub Worksheet_Change(ByVal Target As Range)
With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With
'if any cell in range C16 - C65 is 0 then make D 65
Dim cell As Range
Dim acd As Variant
acd = ActiveCell.Address
For Each cell In Sheets("lists").Range("C15:C65")
If cell.Value 0 Then
cell.Offset(0, 1).Select
If Selection.Value = "" Then
Selection.Value = 65
Else: If Selection.Value = 65 Then GoTo nxcell
End If
End If
nxcell:
Next cell
On Error Resume Next
Range(acd).Offset(0, 0).Select
On Error Resume Next
Dim ws As Worksheet
Dim i As Integer
Set ws = Worksheets("Lists")
If Target.Column = 1 And Target.Row 1 Then
If
Application.WorksheetFunction.CountIf(ws.Range("Jo bDescription"),
Target.Value) Then
Exit Sub
Else: i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range("A" & i).Value = Target.Value
ws.Range("JobDescription").Sort Key1:=ws.Range("A1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If
On Error GoTo 0
With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub