Help with code / collect data from multiple files and write it to worksheet

[snc212]

Hi everyone,

my first post here, have been reading a long time and found a lot of helpful threads though - Thanks everyone!

But my new macro won't work as I want it to. Can you help a newbie out?

Here's my problem: I have a folder with ~1000 xls-files. They are structured in the same way and I need some information taken from all of them and written into a single table. Here's my plan:
- My program shall open each of them, search for a certain keyword
- Then write the content of the cell with that Keyword in my table
- Write the file name into my table as well
- Write the value of "C2" of the worksheet where it found the keyword into my table
- Write the value of the cell next to where it found the keyword into my table
- repeat until all files are checked

Here's what I wrote / copy-pasted from the interwebs.

Sub ABC()
Dim sPath As String, sName As String, sBegriff As String
Dim bk As Workbook, sh As Worksheet
Dim rw As Long
Dim rng As Range

Range("A2:C1000").Clear
Set sh = ActiveSheet 
rw = 2 

Dim strName As String

    
    strName = InputBox(Prompt:="Wo sind die Dateien?", _
          Title:="Daten", Default:="G:\daten1\")
        If strName = "C:\Folder\" Or _
           strName = vbNullString Then
        MsgBox ("Ungültige Eingabe")
           Exit Sub
Else


sPath = strName
sName = Dir(sPath & "*.xls") 
Do While sName <> "" 
 Set bk = Workbooks.Open(sPath & sName)
 Set rng = Range("C1:C11000")
With rng
    Set c = .Find("KEYWORD", LookIn:=xlValues)
    Set k = bk.Range("C2").Value
    If c Is Nothing Then

 bk.Close SaveChanges:=False
 sName = Dir()
 Else ' if value is NO or no then list them
 sh.Cells(rw, "A") = bk.Name
 sh.Cells(rw, "B") = k ' This only writes empty cells...
 sh.Cells(rw, "C") = c 
 ' sh.Cells(rw, "D") = CONTENT OF CELL NEXT TO c on the right?
 rw = rw + 1
 bk.Close SaveChanges:=False
 sName = Dir()
End If
End With
Loop 
End If

End Sub

The prompt works well and it does write the file name and the keyword cell into my table. It does not, however, write what I called "k" and what was supposed to be cell "C2" in the worksheet where it found the keyword. And I have no idea how to make it write what is in the cell next to the keyword.

don't blame me for my newbie-ism, I really try and learn. Thanks for your patience and help!

 

[JLGWhiz]

Hi everyone,

my first post here, have been reading a long time and found a lot of helpful threads though - Thanks everyone!

But my new macro won't work as I want it to. Can you help a newbie out?

Here's my problem: I have a folder with ~1000 xls-files. They are structured in the same way and I need some information taken from all of them and written into a single table. Here's my plan:
- My program shall open each of them, search for a certain keyword
- Then write the content of the cell with that Keyword in my table
- Write the file name into my table as well
- Write the value of "C2" of the worksheet where it found the keyword into my table
- Write the value of the cell next to where it found the keyword into my table
- repeat until all files are checked

Here's what I wrote / copy-pasted from the interwebs.

Sub ABC()
Dim sPath As String, sName As String, sBegriff As String
Dim bk As Workbook, sh As Worksheet
Dim rw As Long
Dim rng As Range

Range("A2:C1000").Clear
Set sh = ActiveSheet 
rw = 2 

Dim strName As String

    
    strName = InputBox(Prompt:="Wo sind die Dateien?", _
          Title:="Daten", Default:="G:\daten1\")
        If strName = "C:\Folder\" Or _
           strName = vbNullString Then
        MsgBox ("Ungültige Eingabe")
           Exit Sub
Else


sPath = strName
sName = Dir(sPath & "*.xls") 
Do While sName <> "" 
 Set bk = Workbooks.Open(sPath & sName)
 Set rng = Range("C1:C11000")
With rng
    Set c = .Find("KEYWORD", LookIn:=xlValues)
    Set k = bk.Range("C2").Value
    If c Is Nothing Then

 bk.Close SaveChanges:=False
 sName = Dir()
 Else ' if value is NO or no then list them
 sh.Cells(rw, "A") = bk.Name
 sh.Cells(rw, "B") = k ' This only writes empty cells...
 sh.Cells(rw, "C") = c 
 ' sh.Cells(rw, "D") = CONTENT OF CELL NEXT TO c on the right?
 rw = rw + 1
 bk.Close SaveChanges:=False
 sName = Dir()
End If
End With
Loop 
End If

End Sub

The prompt works well and it does write the file name and the keyword cell into my table. It does not, however, write what I called "k" and what was supposed to be cell "C2" in the worksheet where it found the keyword. And I have no idea how to make it write what is in the cell next to the keyword.

don't blame me for my newbie-ism, I really try and learn. Thanks for your patience and help!

Write the value of the cell next to where it found the keyword into my table

Left or right?

 

[snc212]

Hi, right in most cases, left in some - I thought I'd figure out how to change it once I see how it's done in general.

 

[JLGWhiz]

Set k = bk.Range("C2").Value

The Set keyword is to be use for Object variables only. When assigning Value to a value variable the Set keyword is omitted. Surprised that no error occurred here. Should be

k = bk.Range("C2").Value