Try this in sheet2 Module:-
NB:- The list updates in sheet2 when the Validation cell "D2" is changed.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
Dim Dn As Range
Dim Ray()
Dim c As Long
If Target.Address(0, 0) = "D2" Then
Application.EnableEvents = False
Select Case Range("D2")
Case "Dave": Set Rng = Sheets("Sheet1").Range("B:B,C:C,D:D").SpecialCells(xlCellTypeConstants)
Case "Jeff": Set Rng = Sheets("Sheet1").Range("E:E,F:F,G:G").SpecialCells(xlCellTypeConstants)
Case "Steve": Set Rng = Sheets("Sheet1").Range("H:H,I:I,J:J").SpecialCells(xlCellTypeConstants)
End Select
For Each Dn In Rng
If Dn = "X" Then
c = c + 1
ReDim Preserve Ray(1 To 2, 1 To c)
Ray(1, c) = Sheets("Sheet1").Cells(Dn.Row, 1)
Ray(2, c) = Right(Sheets("Sheet1").Cells(2, Dn.Column), 1)
End If
Next Dn
With Sheets("Sheet2")
.Range("A:B").ClearContents
.Range("A2:B2").Value = Array("Tool Used", "Option")
If c > 0 Then .Range("A3").Resize(c, 2) = Application.Transpose(Ray)
End With
Application.EnableEvents = True
End If
End Sub
Regards Mick
Bookmarks