ub FindAll() Dim fnd As String, FirstFound As String Dim FoundCell As Range, rng As Range Dim myRange As Range, LastCell As Range 'What value do you want to find (must be in string form)? fnd = "x" Set myRange = Worksheets("Tile").Columns("B:B") Set LastCell = myRange.Cells(myRange.Cells.Count) Set FoundCell = myRange.Find(what:=fnd) 'Test to see if anything was found If Not FoundCell Is Nothing Then FirstFound = FoundCell.Address Else GoTo NothingFound End If Set rng = FoundCell 'Loop until cycled through all unique finds Do Until FoundCell Is Nothing 'Find next cell with fnd value Set FoundCell = myRange.FindNext(after:=FoundCell) FoundCell.Columns("C:C").Select Selection.Copy Dim NextRow As Long NextRow = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row + 1 Sheets(3).Range("A" & NextRow).PasteSpecial Paste:=xlPasteValues 'Add found cell to rng range variable Set rng = Union(rng, FoundCell) 'Test to see if cycled through to first found cell If FoundCell.Address = FirstFound Then Exit Do Loop 'Select Cells Containing Find Value 'rng.Select Exit Sub 'Error Handler NothingFound: MsgBox "No values were found in this worksheet" End Sub
Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.
”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.