Drop Downs in cells B2 & D2 (more to come, maybe 5 + or so).

Code does what I want except the ClearContents which I have commented out.
(Ebable Events is commented out and I am using .Select for testing)

When a selection is made in the drop down, a list pertaining to that selection is copied to the column to the right of the drop down.

I am having trouble clearing that copied list when the next selection is made.
The list are various rows long and the column needs to be clean prior to the next list copied. Can't quite zero in on it, its just me and the late night I suppose!

The Drop Downs will be in every other column in row 2, for however many there will be.

Thanks.
Howard

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B2,D2")) Is Nothing Then Exit Sub

Dim rngFound As Range
Dim aRowCount As Long, _
aColumn As Long, _
tRowCount As Long, _
tColumn As Long

Dim myFnd As String

myFnd = Target

'Application.EnableEvents = False

' tColumn = Target.Offset(, 1).Column
' MsgBox tColumn
' tRowCount = Cells(Rows.Count, tColumn).End(xlUp).Row
' MsgBox tRowCount

' Target.Offset(, 1).Resize(tRowCount, tColumn).Select '.ClearContents
'Exit Sub

Set rngFound = Sheets("Sheet3").Range("AA1:AL1").Find(What:=myFnd , _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not rngFound Is Nothing Then

aColumn = rngFound.Column
aRowCount = Cells(Rows.Count, aColumn).End(xlUp).Row
aColumn = rngFound.Column

rngFound.Offset(1, 0).Resize(aRowCount).Copy Target.Offset(, 1)

Else
MsgBox "No match found."
End If
Application.EnableEvents = True
End Sub