Autofill cells with condition

I'm stuck with a code. I admit I´m not an expert programmer, but despite already having spent a good bit of time searching in the internet, I am not able to build the code. Th开发者_Go百科e situation is this.

I've got in SheetB 2 columns (A and C). In column A I have a bunch of ID numbers and there are always more rows with the same number (ex: ID 12345 is in Row 6 to 15). To each ID number there is a corresponding date in column C.

In SheetA, in Cell C4 I select the ID number and I want to create code that automatically fills the column F (sheetA) starting from row 12 with all the available dates matching the ID in SheetB.

Can someone help me please? Thanks!

Try use this code within your Sheet1 code... feel free to ask if something is not clear.

Edit: Slightly changed clean-up routine.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim oCell As Excel.Range
Dim oCellResult As Excel.Range
Dim oCellClean As Excel.Range
Dim oRangeID As Excel.Range
Dim iCellCount As Integer

If Target.Address = "$C$4" Then

    'Set source data
    Set oRangeID = Sheets(2).Range("A:A")

    'Define initial target for the results obtained
    Set oCellResult = Sheets(1).Range("F12")

    'Clear up any previous data
    'Set oCellClean = oCellResult
    'While Len(oCellClean.Value) > 0
    '    
    '    oCellClean.Clear
    '    Set oCellClean = oCellClean.Offset(1, 0)
    '    
    'Wend

    Set oCellClean = Range(oCellResult, oCellResult.End(xlDown))
    oCellClean.ClearContents

    'Scans source range for match data
    For Each oCell In oRangeID

        If oCell.Value = "" Then Exit For

        If oCell.Value = Target.Value Then

            oCellResult.Offset(iCellCount, 0).Value = oCell.Offset(0, 2).Value
            iCellCount = iCellCount + 1

        End If

    Next oCell

End If

End Sub

Edit:

Updated clean up code. Check if it fits your expectations.

try this:

Dim rgIDsAndDates As Range: Set rgIDsAndDates = Range("name")
Dim DATEs As Collection ' to collect date values for a given ID
Dim IDs   As Collection ' to collect all the DATEs collections for all IDs

' step 1: loop to create (initially empty) collections for each unique ID
Set IDs = New Collection
Dim rgRow As Range
For Each rgRow In rgIDsAndDates.Rows
    Set DATEs = New Collection
    On Error Resume Next
    ' the foll line will save an (empty) DATEs collection keyed by the ID
    Call IDs.Add(DATEs, CStr(rgRow.Cells(1, 1).Value))  ' col 1 as the ID
    On Error GoTo 0
Next rgRow

' step 2: loop to fill each DATEs collection with the dates for that ID
For Each rgRow In rgIDsAndDates.Rows
    ' the foll line retrieves the DATEs for the corresp ID
    Set DATEs = IDs(CStr(rgRow.Cells(1, 1).Value)) ' col 1 has the ID
    Call DATEs.Add(rgRow.Cells(1, 3).Value)        ' store the date from col 3
Next rgRow

' for testing ... list the dates for ID "123"
Set DATEs = IDs("123")
Dim dt As Variant
For Each dt In DATEs
    Debug.Print "date: " & dt
    ' put that dt where you want
Next dt