Menu
  1. Accueil
  2. Tech Forum
  3. Office Software
  4. Excel

VBA return found cell value [Closed]

Report
-
 wil -
Hello,
What I have is a few rows of data, I want to search one column for data between a criteria ( 70 -71), find this data and then return the whole row back to a different range. I am having real trouble with the last bit, I can get it to return the data but in the form of first result, second result etc… can anyone suggest a correction for this?

Private Sub CommandButton1_Click()
Dim FoundCell As Range
Dim LastCell As Range
Dim FirstAddr As String
Dim Si As Variant
Dim I As Variant

For Si = 70 To 71
With Range("F1:F31")
Set LastCell = .Cells(.Cells.Count)
End With
Set FoundCell = Range("F1:F31").find(Si, after:=LastCell)

If Not FoundCell Is Nothing Then
FirstAddr = FoundCell.Address
End If

Do Until FoundCell Is Nothing
For I = 40 To 50
Range("a40:AD50", Cells(i, 1)) = FoundCell.EntireRow.Value
Next i

Set FoundCell = Range("F1:F31").FindNext(after:=FoundCell)
If FoundCell.Address = FirstAddr Then
Exit Do
End If
Loop
Next


End Sub

2 replies

Answer 1 / 2
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
 795
I wonder whether you can find values between two numbers by using "find" function.
anyhow try this macro

modify the macro to suit you. the relevant number data is in A1 down
The relevant rows are copied in sheet 2 
Sub test()
Dim rng As Range, c As Range, dest As Range
With Worksheets("sheet1")
Set rng = Range(.Range("A1"), .Range("A1").End(xlDown))
For Each c In rng
If c >= 70 And c <= 71 Then
c.EntireRow.Copy
Else
GoTo line1
End If
With Worksheets("sheet2")
Set dest = .Cells(Rows.Count, "a").End(xlUp).Offset(1, 0)
dest.PasteSpecial
End With
line1:

Next c
End With

End Sub
2
Thank you
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2942 users have said thank you to us this month

Answer 2 / 2

Ta

With a few customisations I have gotten it to work a treat!

thanks for your help.
Ask a question

Subscribe To Our Newsletter!

The Best of CCM in Your Inbox

Subscribe To Our Newsletter!