Scan file for content

Question

QUESTION:

I have ansheet that contains 20 file names in column B (starting from row 7 on down). Those files are located in the same directory as thefile I need to write the code for. The files are in ascii format and have a .h extension. I need to write some VBA code, that scans through each of those .h files for a specific content. When it finds that content, it must copy and paste the entire line into thesheet.

Example: thesheet has the folowing data: [B7] test.h [B8] second.h

the text we want to scan for is: "check out"

the file test.h has the following content: blabla chek out this blabla blabla check out that check that out too

the file second.h has the following content: bla bla check out my car bla check out his car bla check out this chick blabla

after executing the code, thesheet should have the following content: [B7] test.txt [C7] check out this [D7] check out that [B8] second.txt [C8] check out my car [D8] check out his car [E8] check out this chick blabla

I realy appreciate your help

ANSWER: Tested under the conditions I understood in your description and this worked fine for me:

Sub ABC() Dim LineofText As String Dim rw As Long, sName As String Dim sh As Worksheet, sPath As String, cell As Range Dim r As Range, col As Long Set sh = ActiveSheet

Set r = sh.Range("B7", sh.Cells(sh.Rows.Count, "B").End(xlUp)) sPath = ThisWorkbook.Path If Right(sPath, 1) <> "\" Then sPath = sPath & "\" For Each cell In r

   col = 3
   ' check if the file exists
   sName = Dir(sPath & cell.Text)
   If sName <> "" Then
     Open sPath & cell.Text For Input As #1
     Do While Not EOF(1)
       Line Input #1, LineofText
       If InStr(1, LineofText, "check out", vbTextCompare) Then
         sh.Cells(cell.Row, col).Value = LineofText
         col = col + 1
       End If
     Loop
     Close #1
   Else
     MsgBox sPath & cell.Name & " Does not exist"
   End If

Next End Sub

---------- FOLLOW-UP ----------

QUESTION:

This is great, and it works perfect... you are great! I understand most of it. The one line I have problems uderstanding is this: Set r = sh.Range("B7", sh.Cells(sh.Rows.Count, "B").End(xlUp))

Would you mind explaining it? (I like to know how things work)

Thomas

ANSWER: Thomas

if you go to the last row in column B, hit the end key and then the up arrow, the highlight will move to the last filled cell in column B. that is what this command does (although it doesn't actually move the highlight - it just finds the bottom of the data in column B):

sh.Cells(sh.Rows.Count, "B").End(xlUp)

the "B7" says where to start the range

so I set a reference (r) to the range of cells in column B starting in B7 that contain data.

If the last cell with data is B15 then it is equivalent to

set r = sh.Range("B7","B15")

here is a demonstration from the immediate window:

set sh = Activesheet set r = sh.Range("B7","B15") ? r.Address $B$7:$B$15

Hope that explains it.

---------- FOLLOW-UP ----------

QUESTION: All the sudden I have a problem: All the sudden I get an error message "Runtime error 1004" "Application defined, or object defined error" When I hit click debug, it highlights this line: MsgBox sPath & cell.Name & " Does not exist"

The wierd thing is, it worked at one point.

Any ideas?

Answer

that would mean that one of the files listed was not found - but there is a typo in that line. Cell.name should be cell.value

Sub ABC() Dim LineofText As String Dim rw As Long, sName As String Dim sh As Worksheet, sPath As String, cell As Range Dim r As Range, col As Long Set sh = ActiveSheet

Set r = sh.Range("B7", sh.Cells(sh.Rows.Count, "B").End(xlUp)) sPath = ThisWorkbook.Path If Right(sPath, 1) <> "\" Then sPath = sPath & "\" For Each cell In r

  col = 3
  ' check if the file exists
  sName = Dir(sPath & cell.Text)
  If sName <> "" Then
    Open sPath & cell.Text For Input As #1
    Do While Not EOF(1)
      Line Input #1, LineofText
      If InStr(1, LineofText, "check out", vbTextCompare) Then
        sh.Cells(cell.Row, col).Value = LineofText
        col = col + 1
      End If
    Loop
    Close #1
  Else
    MsgBox sPath & cell.Value & " Does not exist"
  End If

Next End Sub

Apparentlyhadn't executed that line previously - but when it needed to it discovered the typo.

Sorry about that.