Fill down from active cell

[Guest]

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.

 

[Guest]

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