Reputation: 23
I have a macro to search for a value on different sheets. This works fine, but the problem is that I want the value of the entire row, not just the value I'm looking for.
The code is as follows:
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 folder"
If xFileDialog.Show = -1 Then
xStrPath = xFileDialog.SelectedItems(1)
End If
If xStrPath = "" Then Exit Sub
xStrSearch = "searched value"
xUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False
Set xOut = Worksheets.Add
xRow = 1
With xOut
.Cells(xRow, 1) = "book"
.Cells(xRow, 2) = "sheet"
.Cells(xRow, 3) = "cell"
.Cells(xRow, 4) = "search value"
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.Address
.Cells(xRow, 4) = 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 found", , "EA"
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
I need this to look for a value in different books and to return the information of the entire row where the sought value was found.
Upvotes: 2
Views: 410
Reputation: 23974
Based on my best guesses as to what you could mean by "I want the value of the entire row":
To access the entire row as a Range
object
Dim rng As Range
Set rng = xFound.EntireRow
To create a variable (dimensioned (1 To 1, 1 To 16384)
) containing the values of the entire row:
Dim rngValue As Variant
rngValue = xFound.EntireRow.Value
MsgBox rngValue(1, 20) ' will display the value from column T
To individually access certain columns from the row:
MsgBox xFound.EntireRow.Cells(1, "T") ' will display the value from column T
MsgBox xFound.EntireRow.Range("T1") ' will display the value from column T
To set certain destination cells to the value from certain cells on the found row:
'Copy values from columns A to T from original row to columns D to W of the destination
.Cells(xRow, 4).Range("A1:T1").Value = xFound.EntireRow.Range("A1:T1").Value
To simply find the row number on which the find occurred:
MsgBox xFound.Row
Upvotes: 2