Combining 4 workbooks, then searching for cell value

[SteveMc]

Hello all,

Im really in need of help!

I have 4 workbooks in the same folder, Id like to bring them together into one workbook with 4 sheets, then look for a cell value like "MEX" within all 4 sheets, and bring that rows' data into a 5th sheet.
So basically on the 5th sheet I'd have a list of all the rows within those 4 sheets that have the cell value of "mex" within them.

Man, it would be great if someone could help, I'm very new to Excell VBA and have been struggling for days!

Thank you Thank you!:banghead:

[Simon Lloyd]

Fair request steve, but ow many worksheets does each workbook have?, do you just want the values copying over?

Regards,
Simon

[SteveMc]

Hey Simon,

My 4 workbooks each only have sheet1 with values.
Id like to bring over the entire row of data if it includes a cell that has a value of "MEX" and list all those rows on a seperate sheet.
What do you think?

[Simon Lloyd]

This link from a previous post here at VBA Express will combine your workbooks and has full instructions http://www.vbaexpress.com/kb/getarticle.php?kb_id=829 and this should copy and paste which ever word you look for to sheet 3

Sub findwords()
Dim ws As Worksheet
Dim rng, rng1 As Range
Dim MyCell
Dim T1
Dim lastrow
'On Error Resume Next
Set rng = Sheets("Sheet3").Range("A65536").End(xlUp)(2)
Set rng1 = Sheets("Sheet1").Range("A:A")
T1 = InputBox("Enter Word To Be Found", "Word Finder")
For Each ws In Worksheets
For Each MyCell In rng1
If LCase(MyCell) = LCase(T1) Then
MyCell.EntireRow.Copy
Sheets("sheet3").Activate
rng.Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Next
Next
End Sub

Regards,
Simon

[Simon Lloyd]

Steve in hind sight my code is full of flaws!, i tried some variations thought i had something workable with only what i saw was one flaw, however asking a Guru here to take a look at it produced this Sub SimonsCopy()
Const TARGET_SHEET As String = "Sheet3"
Dim sh As Worksheet
Dim iLastRow As Long
Dim sWord As String
Dim rng As Range
Dim cell As Range

iLastRow = 1
Worksheets(TARGET_SHEET).Cells.ClearContents
sWord = InputBox("Which word to look for?", "Word Finder")
If sWord <> "" Then
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> TARGET_SHEET Then
Set rng = FindWord(sh.UsedRange, sWord)
If Not rng Is Nothing Then
For Each cell In rng
cell.EntireRow.Copy Worksheets(TARGET_SHEET).Range("A" & iLastRow)
iLastRow = iLastRow + 1
Next cell
End If
End If
Next sh
End If

End Sub


Private Function FindWord(Target As Range, _
LookFor As String) As Range
Dim oCell As Range
Dim rng As Range
Dim sFirst As String

With Target
Set oCell = .Find(LookFor, LookIn:=xlValues)
If Not oCell Is Nothing Then
sFirst = oCell.Address
Set rng = Target.Parent.Range("A" & oCell.Row)
Do
Set rng = Union(rng, Target.Parent.Range("A" & oCell.Row))
Set oCell = .FindNext(oCell)
Loop While Not oCell Is Nothing And oCell.Address <> sFirst
End If
End With

Set FindWord = rng

End Function put it in a standard module...........enjoy!

This was by kind donation of xld or infamously known as "El Xid"

regards,
Simon