Sure, but I would use a completely different approach.
Sub mrmattmc2()
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set t1 = Worksheets("T1")
OpenRow = 1
SearchFor = "Blue"
Set SearchRange = ws1.Range("X1:X" & ws1.Cells(Rows.Count, "X").End(xlUp).Row)
Set c = SearchRange.Find(SearchFor)
If Not c Is Nothing Then
FirstAdd = c.Address
Do
t1.Cells(OpenRow, "R").Value = ws1.Cells(c.Row, "B").Value
OpenRow = OpenRow + 1
Set c = SearchRange.FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAdd
End If
Set SearchRange = ws2.Range("X1:X" & ws2.Cells(Rows.Count, "X").End(xlUp).Row)
Set c = SearchRange.Find(SearchFor)
If Not c Is Nothing Then
FirstAdd = c.Address
Do
t1.Cells(OpenRow, "R").Value = ws2.Cells(c.Row, "C").Value
OpenRow = OpenRow + 1
Set c = SearchRange.FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAdd
End If
SortColumn = "$R$1:$R" & t1.Cells(Rows.Count, "R").End(xlUp).Row
With t1.Sort
.SetRange Range(SortColumn)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
t1.Range(SortColumn).RemoveDuplicates Columns:=1, Header:=xlNo
End Sub
Bookmarks