Macro to find specific text in specific file name

[Sunvisor]

I have a specific directory and was able to get all the names of the files with the below code. They are now listed in column A, 1-400.

I used this code.

Sub listfiles()
Dim f As String, i As Integer
f = Dir("C:\Documents and Settings\M08040.ADNE\My Documents\Can Delete\Doug52WeekEmployee Volumes\")
i = 1
Do While Len(f) <> 0
    Cells(i, "A") = f
    f = Dir
    i = i + 1
Loop
End Sub
 
I now want to go into the directory and after Doug52WeekEmployee Volumes\ put the file name which is in A1-400...so something like Doug52WeekEmployee Volumes\A1.
 
Any ideas?..Also I then have the problem where I need it to find the specific text "Job Description:" and copy the 2 cells directly next to this word.
 
Thanks for any help guys!

 

[rconverse]

For sake of simplicity, close all workbooks except the one that you want to copy your data in to.

When you're in VBE, you'll see sheets1, 2, 3, and This Workbook in the upper left corner of your screen. Right click and then insert module. Copy and paste my entire code into the module that you just created and it will run.

Also, you'll need to change the bolded:

        'pastes the information in the last row of your spreadsheet
        Windows("YourSpreadsheetName.xls").Activate   'change this to the worksheet you're copying your data in to
        Set ws = ActiveWorkbook.Sheets(1)
        lngLastRow1 = ws.Range("A65536").End(xlUp).Row + 1
        Range("A" & lngLastRow1).PasteSpecial xlPasteValues
        Application.CutCopyMode = False

 

[Sunvisor]

I've tried again and got Run-Time Error '1004' App-Definded or object defined error...not sure what I'm doing wrong.

 

[Sunvisor]

and highlights

Set rng = wsmf.Cells.Find(What:="Total Jobs:", After:=Range("A1")).Offset(0, -2).Resize(, 2)

 

[Sunvisor]

maybe the problem is that the "Total Jobs" is not in A1 for every file...it is in a different cell for each...thats the main problem, i need for it to go into each of the files in the directory, search for that, then copy the two numbers to the left

 

[rconverse]

maybe the problem is that the "Total Jobs" is not in A1 for every file...it is in a different cell for each...thats the main problem, i need for it to go into each of the files in the directory, search for that, then copy the two numbers to the left

Set rng = wsmf.Cells.Find(What:="Total Jobs:", After:=Range("A1")).Offset(0, -2).Resize(, 2)

This will find "Totat Jobs:" in any cell in the worksheet. In my test, it was in cell E24 and it copies the two cells to the left.

Do you have rng declared as a range?

Dim rng As Range

 

[rconverse]

I found the mistake. Re-copy this and make changes where it's bolded and underlined in the post. I've added *** to everywhere that needs changed.

Sub FindTotalJobs()
Dim path As String
Dim FileName As String
Dim Wkb As Workbook
Dim wsmf As Worksheet
Dim lngLastRow1 As Long
Dim wkb1 As Workbook
Dim rng As Range
    
Call ToggleEvents(False)

    '###################################
    path = "C:\Documents and Settings\rconverse\My Documents\Test1"  '***Change as needed
    '###################################
    FileName = Dir(path & "\*.xls", vbNormal)  '***Change as needed (Are you looking for xls or xlsx files?)
    
    Do Until FileName = ""
        
        'this opens the workbook in the above specified folder
        Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName)
        
        'set this to the sheet number to look at
        Set wsmf = Wkb.Sheets(1) ' Use this line if want first sheet every time
        
        'moves to next spreadsheet if no "Job Description" is not found
        On Error GoTo NotFound  '***I had this commented out, so if it didn't find "Total Jobs:" it wasn't skipping the error.
        
        'finds job description
        Set rng = wsmf.Cells.Find(What:="Total Jobs:", After:=Range("A1")).Offset(0, -2).Resize(, 2)
        rng.Copy
        
        'pastes the information in the last row of your spreadsheet
        Windows("Macro.xls").Activate  '***This needs to be the name of your spreadsheet where you are copying the cell data into
        Set ws = ActiveWorkbook.Sheets(1)
        lngLastRow1 = ws.Range("A65536").End(xlUp).Row + 1
        Range("A" & lngLastRow1).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    
NotFound:

    FileName = Dir()
    
    Wkb.Close
    
    Loop

Call ToggleEvents(True)

End Sub
Sub ToggleEvents(blnState As Boolean)

'Originally written by firefytr
    
    With Excel.Application
        .DisplayAlerts = blnState
        .EnableEvents = blnState
        .ScreenUpdating = blnState
        If blnState Then .CutCopyMode = False
        If blnState Then .StatusBar = False
    End With
    
End Sub

 

[Sunvisor]

AHh! the problem was I needed to look to the RIGHT and not the left, the Total Jobs was in A1, so it couldn't possible look to the left...Thank you, I got it to work nowww!!!

you are the man!!

 

[Sunvisor]

Actually I have a problem, I have another macro that is getting all the names of each file and when I line up I realized that its skipping the ones that are not found so I don't know which ones are those files that don't have that word in it...is there a way to paste 0 0 if its not found ?

it never ends =[

 

[Sunvisor]

after Not Found: can we say, skip a row and continue?

 

[rconverse]

Just insert this code between the bolded and underlined lines.

...NotFound:

    If Err.Number > 0 Then
        Windows("Macro.xls").Activate
        Set ws = ActiveWorkbook.Sheets(1)
        lngLastRow1 = ws.Range("A65536").End(xlUp).Row + 1
        Range("A" & lngLastRow1).Value = " "
    End If
    
    Err.Clear
    
    FileName = Dir()

...

HTH,
Roger