Copy rows from one sheet to another based on value

[gmacmillan1982]

https://www.dropbox.com/s/vcgf5rfenswgheu/Checklists.xlsm?dl=0

Hi,

I've been working on this for a while. I have info from one tab that I'm looking to have transferred to another sheet based on if the criteria is met. Anyone able to help me out? Copy the whole row to another sheet if criteria is met.

 

[pmich]

Try this code to copy one row of data which matches with your criteria.

Private Sub cmdSerachInfoBasedOnCriteriaCopyRowToAnotherSheet_Click()
 Dim UsrCriteria As Long 'if criteria is a string edit this accordingly
 Dim varCriteriaRowNum As Long
 Dim Src As Worksheet
 Dim Rpt As Worksheet
 Dim CopRng As Range
 Set Src = Sheets("Source")
 Set Rpt = Sheets("Report")
 Src.Select
 '''''''''''''''''''''' Pin Point Search begins ''''''''''''''''''''''''''''''''''''''''
 Dim rSrchCriteria As Range 'range to check whether Criteria is available
 Range("A1").Select 'Col A has Criteria in Src
 UsrCriteria = InputBox("Type the Criteria" & vbCrLf & _
   "to search :", "Criteria!")
 Set rSrchCriteria = Range("A:A").Find(UsrCriteria, , xlValues, xlWhole)
 'code below searches Citeria, only in the column specified above as Selected Range.
 If rSrchCriteria Is Nothing Then 'if Criteria is 38, & no record is matching, _
  then, 38 is not found.
  MsgBox "You typed: " & UsrCriteria & "." & vbCrLf & _
   "This is not FOUND." & vbCrLf & _
   "So, Nothing to copy!"
   Exit Sub
 Else 'rSrchCriteria Is Nothing 'if Criteria is 38, _
  record found may be 388. So, moving pointer to that record.
  With rSrchCriteria
   .Activate 'Pointer moved to that record.
  End With
  If Val(rSrchCriteria) <> Val(UsrCriteria) Then 'if User Criteria is 38, _
   Srch Criteria found may be 388. So, 38 is not found.
   MsgBox "You typed: " & UsrCriteria & "." & vbCrLf & _
   "This is not FOUND." & vbCrLf & _
   "So, Nothing to copy!"
   Exit Sub
  ElseIf Val(rSrchCriteria) = Val(UsrCriteria) Then 'if Criteria is 38 and _
   record found is 38, then 38 is found.
   varCriteriaRowNum = ActiveCell.Row 'Store Row Criteria
  End If 'Val(rSrchCriteria) <> Val(UsrCriteria)
 End If 'rSrchCriteria Is Nothing
  '''''''''''''''''''''' Pin Point Search ends ''''''''''''''''''''''''''''''''''''''''
  Rpt.Cells.ClearContents 'Erases all rows in Report Sheet. If you dont want to erase all rows, edit A2 given below. 
  Set CopRng = Src.Range("A" & Trim(Str(varCriteriaRowNum))).EntireRow
  CopRng.Copy Rpt.Range("A2") 'Copies the searched row in Report Sheet 'If you want to paste on a specific row, edit A2.
  Rpt.Select
End Sub

You have not mentioned whether you want to search some other criteria or not.

 

[Michael M]

What criteria ?
Where do we match the criteria ?
Which Sheet is the row copied to ?
The link doesn't really provide much to go on !!