Don't know how to start

Ossian13

New Member
Joined
Oct 21, 2016
Messages
46
Hi everyone,

i have to run a weekly report with diffrent cases. Each case has an approval path and must be approved by 6 persons. I have to find all the cases which have John Doe in the approval path, either is he the first approver or the last, this does not matter. If John Doe is in the approval path then i need the case. In the end i need to have in my list all the cases where John Doe is in the approval path.

Can you tell me a point to start here? What would be the best approach in solving this?

Thank you in advance,
Ossian
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
It would help if you could design a sample worksheet that includes a column with all your cases and then the next 6 columns containing the names of the people who do the approving in each row to the right of each case. Also show where you want your list to be placed. Perhaps you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do referring to specific cells and worksheets.
 
Upvote 0
.
Paste in Routine Module :

Code:
Option Explicit


Sub SearchFolders()
    Dim fso As Object
    Dim fld As Object
    Dim strSearch As String
    Dim strPath As String
    Dim strFile As String
    Dim wOut As Worksheet
    Dim wbk As Workbook
    Dim wks As Worksheet
    Dim lRow As Long
    Dim rFound As Range
    Dim strFirstAddress As String


    
    Application.ScreenUpdating = False


    'Change as desired
    strPath = "c:\Users\My\Desktop\"                 '<--- Change directory here
    strSearch = Application.InputBox("Enter Name", "Search Name", Type:=2)           '<--- Change term to search for here
    On Error Resume Next
    If strSearch = 0 Then
        Exit Sub
    End If
    On Error GoTo ErrHandler
    Set wOut = Worksheets.Add
    lRow = 1
    
    With wOut
        .Cells(lRow, 1) = "Workbook"
        .Cells(lRow, 2) = "Worksheet"
        .Cells(lRow, 3) = "Cell"
        .Cells(lRow, 4) = "Text in Cell"
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set fld = fso.GetFolder(strPath)


        strFile = Dir(strPath & "\*.xls*")  '<-- Currently searching all Excel files. Change extension here
        Do While strFile <> ""
            Set wbk = Workbooks.Open _
              (Filename:=strPath & "\" & strFile, _
              UpdateLinks:=0, _
              ReadOnly:=True, _
              AddToMRU:=False)


            For Each wks In wbk.Worksheets
                Set rFound = wks.UsedRange.Find(strSearch)
                If Not rFound Is Nothing Then
                    strFirstAddress = rFound.Address
                End If
                Do
                    If rFound Is Nothing Then
                        Exit Do
                    Else
                        lRow = lRow + 1
                        .Cells(lRow, 1) = wbk.Name
                        .Cells(lRow, 2) = wks.Name
                        .Cells(lRow, 3) = rFound.Address
                        .Cells(lRow, 4) = rFound.Value
                    End If
                    Set rFound = wks.Cells.FindNext(After:=rFound)
                Loop While strFirstAddress <> rFound.Address
            Next


            wbk.Close (False)
            strFile = Dir
        Loop
        .Columns("A:D").EntireColumn.AutoFit
    End With
    MsgBox "Done"


ExitHandler:
    Set wOut = Nothing
    Set wks = Nothing
    Set wbk = Nothing
    Set fld = Nothing
    Set fso = Nothing
    Application.ScreenUpdating = True
    Exit Sub


ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,903
Messages
6,175,287
Members
452,631
Latest member
a_potato

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top