Find function in VBA

[manoj_arsul]

Dear All ,

Can you please Help me to find function in VBA.

Conditions:
Enter any value in cell A10 - Sheet 1 (already fixed button - for click)
Find that value in each workbook like Sheet 3,Sheet 4, sheet 5, sheet 6......etc .
eg. if value is found in sheet 3 and sheet 4 then out put will be in sheet 2
ie. copied entire that row (multiple rows- if the value found multiple time) and 1st row of the sheet 3 & sheet 4 and paste in Sheet 2.

Eg. I am searching word America. - (clicked on Button)

Sheet 3.

Country	Student Count	Passed	Failed
China	1000	800	200
America	500	480	20
Japan	500	470	30

Sheet 4.

Capital	Country	Student Count	Failed	Pass
Tokyo	Japan	400	50	350
Washington	America	100	15	85
London	England	700	100	600
Capetown	South Africa	500	50	450
Washington	America	400	20	380

Output in Sheet 2.

Country	Student Count	Passed	Failed
America	500	480	20

Capital	Country	Student Count	Failed	Pass
Washington	America	100	15	85
Washington	America	400	20	380

If the Value/word is not found the Popup Mssg "Enter Value not present in File etc"


Thanks in Advance!

 

[DanteAmor]

How about:

Sub find_multiple_rows()
  Dim sh As Worksheet, i As Long, n As Long, iRow As Long
  Dim c As Range, r As Range, f As Range, cell As Long
  '
  Set sh = Sheets("Sheet2")
  sh.Cells.ClearContents
  n = 2
  '
  For i = 3 To Sheets.Count
    Set r = Sheets(i).Cells
    Set f = r.Find(Sheets("Sheet1").Range("A10"), , xlValues, xlPart)
    If Not f Is Nothing Then
      cell = f.Row
      iRow = 0
      Do
        If f.Row <> iRow Then
          f.EntireRow.Copy sh.Range("A" & n)
          n = n + 1
          iRow = f.Row
        End If
        Set f = r.FindNext(f)
      Loop While Not f Is Nothing And f.Row <> cell
    End If
  Next i
  If iRow = 0 Then MsgBox "Enter Value not present in File"
End Sub

 

[manoj_arsul]

@DanteAmor Thank you DanteAmor thank you so much !

 

[manoj_arsul]

@DanteAmor : But it is not copied first row like

Country

Student Coun

Capital

Country

Is it possible, at same time copied first row if data text/value found in that sheet only.

 

[DanteAmor]

copied first row

Try this

Sub find_multiple_rows()
  Dim sh As Worksheet, i As Long, n As Long, iRow As Long
  Dim c As Range, r As Range, f As Range, cell As Long
  '
  Set sh = Sheets("Sheet2")
  sh.Cells.ClearContents
  n = 1
  '
  For i = 3 To Sheets.Count
    Set r = Sheets(i).Cells
    Set f = r.Find(Sheets("Sheet1").Range("A10"), , xlValues, xlPart)
    If Not f Is Nothing Then
      cell = f.Row
      iRow = 0
      Sheets(i).Rows(1).Copy sh.Range("A" & n)
      n = n + 1
      Do
        If f.Row <> iRow Then
          f.EntireRow.Copy sh.Range("A" & n)
          n = n + 1
          iRow = f.Row
        End If
        Set f = r.FindNext(f)
      Loop While Not f Is Nothing And f.Row <> cell
    End If
  Next i
  If iRow = 0 Then MsgBox "Enter Value not present in File"
End Sub

 

[manoj_arsul]

@DanteAmor : Sorry but its not getting accurate result. I want first row upside from that sheet where we have found the value/ text.
Like we found America in sheet4 then in sheet2 if result amrica ... then in upside row we have to copy paste First row (Country, Student count...)

 

[DanteAmor]

That is what the macro does:

Libro6
	A	B
9
10	America
11
Sheet1

Libro6
	A	B	C	D
1	Country	Student Count	Passed	Failed
2	China	1000	800	200
3	America	500	480	20
4	Japan	500	470	30
Sheet3

Libro6
	A	B	C	D	E
1	Capital	Country	Student Count	Failed	Pass
2	Tokyo	Japan	400	50	350
3	Washington	America	100	15	85
4	London	England	700	100	600
5	Capetown	South Africa	500	50	450
6	Washington	America	400	20	380
Sheet4

Result:

Libro6
	A	B	C	D	E
1	Country	Student Count	Passed	Failed
2	America	500	480	20
3	Capital	Country	Student Count	Failed	Pass
4	Washington	America	100	15	85
5	Washington	America	400	20	380
Sheet2

What does the macro do, it gives you more records?
then change this line:
Set f = r.Find(Sheets("Sheet1").Range("A10"), , xlValues, xlPart)
For this:
Set f = r.Find(Sheets("Sheet1").Range("A10"), , xlValues, xlWhole)

 

[manoj_arsul]

@DanteAmor : Thank you muchhhhh

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.