Create Userform For the Value Search VBA Code

[SDB]

Hi All,
I have been trying to create the user form for the below provided code, however I am not being successful.
The code below is to search a specific value in multiple sheets in a folder and return the entire row as a result.
Your help to create a user form is highly appreciated.

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 = "SEARCH THIS"

    xUpdate = Application.ScreenUpdating

    Application.ScreenUpdating = False

    Application.EnableEvents = False

    Set xOut = Worksheets.Add

    xRow = 1

    With xOut

        .Cells(xRow, 1) = "Workbook"

        .Cells(xRow, 2) = "Worksheet"

        .Cells(xRow, 3) = "Cell"

        .Cells(xRow, 4) = "Result"

        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).Formula = "=HYPERLINK(""" & xWb.FullName & """)"

                        .Cells(xRow, 4).Range("A1:BA1").Value = xFound.EntireRow.Range("A1:BA1").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", , "Result"

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

 

[SDB]

Sample file attached