F.A.O Mike H

[leerem]

Hi Mike,
You gave me the code as attached below for listing the
contents of a folder:

Private Sub Worksheet_Activate()
ListBox1.Clear
MyPath = "C:\"
MyName = Dir$(MyPath & "*.xls") 'only looks for xl files
With ListBox1
Do While MyName <> ""
MyName = Left(MyName, Len(MyName) - 4) 'removes .XLS from end of name
..AddItem MyName
MyName = Dir
Loop
End With
End Sub

The List box will need to be generated and activated only when the user
selects Sheet1.Range("D7")
Could this be added to an existing routine below - and if so how would I go
about doing it.......

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Lastrow As Integer

If Target.Cells.Count > 1 Then
Exit Sub
End If

Lastrow = Sheets("sheet1").Cells(Rows.Count, "Y").End(xlUp).Row

If Not Application.Intersect(Range("I7"), Target) Is Nothing Then

With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$Y$3:$Y" & Lastrow
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
End If

' Enter new code here

End Sub

 

[Mike H]

I responded in your other post

 

[leerem]

Mike,
with respect I still cant get it to work.

I need to generate the list box possibly through validation. I've tried to
enter a Activex Control list box but this interfers with my Calendar funtion
which no longer works as soon as i place an ActiveX control on the worksheet.

Could your code be modified to work at the base of the routine below:-

Regards
Lee

 

[Mike H]

This should combine the 2

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Lastrow As Long
If Target.Cells.Count > 1 Then Exit Sub
Lastrow = Sheets("sheet1").Cells(Rows.Count, "Y").End(xlUp).Row
If Not Application.Intersect(Range("I7,D7"), Target) Is Nothing Then
If Target.Address = "$I$7" Then
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop,
Operator:= _
xlBetween, Formula1:="=$Y$3:$Y" & Lastrow
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
Else
ListBox1.Clear
MyPath = "C:\"
MyName = Dir$(MyPath & "*.xls") 'only looks for xl files
With ListBox1
Do While MyName <> ""
MyName = Left(MyName, Len(MyName) - 4) 'removes .XLS from end of
name
.AddItem MyName
MyName = Dir
Loop
End With
End If
End If

Mike