Search for string in several workbooks and retrieve data from another column?

[ESEKOCK]

Hi there,
I am a beginner in excel Macros and need support.

I have 10 excel workbooks in one folder and each workbook contains approx 32 worksheets.

I need to search for a certain string in column A in all workbooks and worksheets and retrieve the data that in column D.
My end result I would like to have is something like the below.
Workbook Worksheet "Value in column D"
a xx "Value xx"
b yy "Value yy"
c zz "Value ZZ"


I found the below formulas that almost fulfills my needs with the exception that it shows the value that I search for but I need the value in column D in the same row. See below for .Cells(xRow, 3)=....

I hope that someone can support.

Br Thomas

Sub SearchFolders()

Dim xFso As Object
Dim xFld As Object
Dim xStrSearch As String
Dim xStrPath As String
Dim xStrFile As String
Dim xOut As Worksheet
Dim xWb As Workbook
Dim xWk As Worksheet
Dim xRow As Long
Dim xFound As Range
Dim xStrAddress As String
Dim xFileDialog As FileDialog
Dim xUpdate As Boolean
Dim xCount As Long
On Error GoTo ErrHandler
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Select a forlder"
If xFileDialog.Show = -1 Then
xStrPath = xFileDialog.SelectedItems(1)
End If
If xStrPath = "" Then Exit Sub
xStrSearch = "Sum Telecom equipment Services fees"
xUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False
Set xOut = Worksheets.Add
xRow = 1
With xOut
.Cells(xRow, 1) = "Workbook"
.Cells(xRow, 2) = "Worksheet"
.Cells(xRow, 3) = "Text in Cell"
Set xFso = CreateObject("Scripting.FileSystemObject")
Set xFld = xFso.GetFolder(xStrPath)
xStrFile = Dir(xStrPath & "\*.xls*")
Do While xStrFile <> ""
Set xWb = Workbooks.Open(Filename:=xStrPath & "\" & xStrFile, UpdateLinks:=0, ReadOnly:=True, AddToMRU:=False)
For Each xWk In xWb.Worksheets
Set xFound = xWk.UsedRange.Find(xStrSearch)
If Not xFound Is Nothing Then
xStrAddress = xFound.Address
End If
Do
If xFound Is Nothing Then
Exit Do
Else
xCount = xCount + 1
xRow = xRow + 1
.Cells(xRow, 1) = xWb.Name
.Cells(xRow, 2) = xWk.Name
.Cells(xRow, 3) = xFound.Value
End If
Set xFound = xWk.Cells.FindNext(After:=xFound)
Loop While xStrAddress <> xFound.Address
Next
xWb.Close (False)
xStrFile = Dir
Loop
.Columns("A:D").EntireColumn.AutoFit
End With
MsgBox xCount & "cells have been found", , "Kutools for Excel"
ExitHandler:
Set xOut = Nothing
Set xWk = Nothing
Set xWb = Nothing
Set xFld = Nothing
Set xFso = Nothing
Application.ScreenUpdating = xUpdate
Exit Sub
ErrHandler:
MsgBox Err.Description, vbExclamation
Resume ExitHandler
End Sub

[Logit]

Duplicate post.

[bakerman2]

ESEKOCK, welcome to the forum.

Unfortunately your post doesn't comply with following Forum Rules.

Your post does not comply with Rule 1 of our Forum RULES. Your post title should accurately and concisely describe your problem, not your anticipated solution.

Use terms appropriate to a Google search. Poor thread titles, like Please Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will be addressed according to the OP's experience in the forum: If you have less than 10 posts, expect (and respond to) a request to change your thread title. If you have 10 or more posts, expect your post to be locked, so you can start a new thread with an appropriate title.

To change a Title go to your first post, click EDIT then Go Advanced and change your title, if 2 days have passed ask a moderator to do it for you.

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between [CODE]Please [url=https://www.excelforum.com/login.php]Login or Register [/url] to view this content.[/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Click on Edit to open your thread, then highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here