Avatar of Sam S
Sam S

asked on 

VBA Loop that Finds a Row and Pastes in Next Open Row

I am new to VBA and have managed to piece together some code (with your help) that the finds an "X" on the first page then transfers information from that row to the first blank row on another page. It currently does the job, but puts the first found record at the end of the list. It might be an easy fix, I just seem to be making it worse!

Two questions: How can I get it to spit out in the right order?
       Also, is this the most efficient way to do it? I only need to reference the first 100 rows on either page. If I stop referencing the entire column would that speed things up noticeably?

Thank you so much for any help!!
Samantha

Oh and thanks to thespreadsheetguru.com for getting me started.

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

Open in new window

VBA

Avatar of undefined
Last Comment
Sam S

8/22/2022 - Mon