ExcelBanter - Fill down from active cell

Try the following code. You need to place it ito the code module of the
target worksheet.

Option Explicit

Private shtDonor As Worksheet, rTempRng As Range
Private x As Variant

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Declare the proceedure variables
Dim sTempAdrs As String
' Assing values
Set rTempRng = Range("k1:k4")
sTempAdrs = rTempRng.Address
Set shtDonor = ThisWorkbook.Sheets("Sheet1")
' Investigate active cell
If ActiveCell.Address = Range("a1").Address Or _
ActiveCell.Address = Range("d1").Address Or _
ActiveCell.Address = Range("g1").Address Then
' Create temporary titles list
x = shtDonor.Range("a1:d1")
rTempRng = WorksheetFunction.Transpose(x)
' Attach validation to the active cell
With ActiveCell
.Value = "Select List"
With .Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertInformation, _
Operator:=xlBetween, Formula1:="=" & sTempAdrs
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = "Input Title Text"
.InputMessage = "Input Message text"
.ShowInput = True
End With
End With
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
' Declare proceedure variables
Dim rList1 As Range, rList2 As Range
Dim rList3 As Range, rList4 As Range
Dim iCntr As Integer
' Assign values
Set shtDonor = ThisWorkbook.Sheets("Sheet1")
Set rList1 = shtDonor.Range("a2:a10")
Set rList2 = shtDonor.Range("b2:b10")
Set rList3 = shtDonor.Range("c2:c10")
Set rList4 = shtDonor.Range("d2:d10")
' Fill the list
Select Case ActiveCell.Address
Case Range("a1").Address
Select Case Range("a1").Value
Case "List 1"
iCntr = WorksheetFunction.CountA(rList1)
x = rList1
Range(Cells(1, 1), Cells(iCntr, 1)).Clear
Range(Cells(1, 1), Cells(iCntr, 1)) = x
Case "List 2"
iCntr = WorksheetFunction.CountA(rList2)
x = rList2
Range(Cells(1, 1), Cells(iCntr, 1)).Clear
Range(Cells(1, 1), Cells(iCntr, 1)) = x
Case "List 3"
iCntr = WorksheetFunction.CountA(rList3)
x = rList3
Range(Cells(1, 1), Cells(iCntr, 1)).Clear
Range(Cells(1, 1), Cells(iCntr, 1)) = x
Case "List 4"
iCntr = WorksheetFunction.CountA(rList4)
x = rList4
Range(Cells(1, 1), Cells(iCntr, 1)).Clear
Range(Cells(1, 1), Cells(iCntr, 1)) = x
End Select
Case Range("d1").Address
' Copy and amend the above code
Case Range("g1").Address
' Copy and amend the above code
End Select
End Sub

regards,

Alasdair Stirling

"Neal" wrote:

I have 4 dynamic ranges setup in my workbook. I would like to be able to do
the following:

When i activate certain cells on another sheet (a1,d1 or g1) i am presented
with an option to select one of the four named ranges. When a selection is
made, the cells are filled down from the activecell with the values
associated with the chosen range.

All assistance greatly appreciated.