We help IT Professionals succeed at work.
Get Started

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

Sam S
Sam S asked
on
125 Views
Last Modified: 2017-04-04
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

Comment
Watch Question
CERTIFIED EXPERT
Top Expert 2016
Commented:
This problem has been solved!
Unlock 1 Answer and 2 Comments.
See Answer
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE