Problem with openning closed xls files which have names in main xls in a column and then taking data from them with Vlookup

[jasmin10]

Dear Experts,
I have tried all night and day to solve this problem.
I have a main excel file for the results and approximately 500 excel names in acolumn in that main excel. In another folder a have nearly 300 excel files. What I want to do is:
1-Read the first cell (in the main excel) that is (cell: "B3").
2-Find the file named ("B3"=ADANA) in 'E:\BIST\DATA\FINANSALLAR\2009-12\("B3").
3-Open that excel file.
4- Search for a string named "NÜFUS".
5- Take the third column value written near "NÜFUS" word. (VLOOKUP?)
6- Copy the value to the main excel cell: "C3"
7-Save main excel.
8- Read the next cell (in the main excel) that is (cell: B4)
9-Find the file named ("B4"=ANKARA) in 'E:\BIST\DATA\FINANSALLAR\2009-12\("B4").
10- Open the file named B4.
11-Close the file named B3.
12- Search for the same string named "NÜFUS".
13-Take the third column value written near "NÜFUS" word.
14- Copy the value to the main excel cell: "C4"
.... This will continue for 500 excel cells in the main excel. End up in B503.

I appreciate for your helps. I found many links and tried most of them but I am lost.
Thank you...

 

[davesexcel]

This will loop through Column B and get the info.
Check `Rng.Offset(, 3).Value` it may need to change the offset to 2

Sub LoopThroughFolder()
    Dim c As Range, MyRng As Range
    Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
    Dim Rng As Range, sh As Worksheet
    
    Set Wb = ThisWorkbook
    Set sh = Wb.Sheets(1)     'first sheet in workbook
  
    MyDir = "C:\Users\davem\Downloads\WorkBookLoop\"  'change the address to suite
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    With sh
        Set MyRng = .Range("B2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
        For Each c In MyRng.Cells

            MyFile = Dir(MyDir & c & ".xls")     'change file extension
            ChDir MyDir
            
            Workbooks.Open (MyFile)

            With Worksheets("Sheet1")
                Set Rng = .Cells.Find("NÜFUS")
                If Not Rng Is Nothing Then
                    With sh
                        .Cells(.Rows.Count, "C").End(xlUp).Offset(1).Value = Rng.Offset(, 3).Value
                    End With
                End If
                ActiveWorkbook.Close True
            End With

            MyFile = Dir()
        Next c
        
    End With
    
    Wb.Save
End Sub

 

[mohadin]

May be

Sub test()
    Dim i As Long
    Dim Dwb As Workbook
    Dim fnd As Range
    For i = 3 To 503
        Set Dwb = Workbooks.Open("E:\BIST\DATA\FINANSALLAR\2009-12\" & b(i) & ".xls*")
        Set Dwb = ActiveWorkbook
        Set fnd = Dwb.Sheets(1).Range("A:A").Find(what:="xxx", LookIn:=xlValues, lookat:=xlWhole)
        fnd.Offset(, 3).Copy ThisWorkbook.Sheets("sheet2").Range("C" & i)
        Dwb.Close False
    Next
End Sub

 

[jasmin10]

This will loop through Column B and get the info.
Check `Rng.Offset(, 3).Value` it may need to change the offset to 2

Sub LoopThroughFolder()
    Dim c As Range, MyRng As Range
    Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
    Dim Rng As Range, sh As Worksheet
   
    Set Wb = ThisWorkbook
    Set sh = Wb.Sheets(1)     'first sheet in workbook
 
    MyDir = "C:\Users\davem\Downloads\WorkBookLoop\"  'change the address to suite
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    With sh
        Set MyRng = .Range("B2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
        For Each c In MyRng.Cells

            MyFile = Dir(MyDir & c & ".xls")     'change file extension
            ChDir MyDir
           
            Workbooks.Open (MyFile)

            With Worksheets("Sheet1")
                Set Rng = .Cells.Find("NÜFUS")
                If Not Rng Is Nothing Then
                    With sh
                        .Cells(.Rows.Count, "C").End(xlUp).Offset(1).Value = Rng.Offset(, 3).Value
                    End With
                End If
                ActiveWorkbook.Close True
            End With

            MyFile = Dir()
        Next c
       
    End With
   
    Wb.Save
End Sub

Thank you very much for the codes. I am trying them now.

 

[jasmin10]

May be

Sub test()
    Dim i As Long
    Dim Dwb As Workbook
    Dim fnd As Range
    For i = 3 To 503
        Set Dwb = Workbooks.Open("E:\BIST\DATA\FINANSALLAR\2009-12\" & b(i) & ".xls*")
        Set Dwb = ActiveWorkbook
        Set fnd = Dwb.Sheets(1).Range("A:A").Find(what:="xxx", LookIn:=xlValues, lookat:=xlWhole)
        fnd.Offset(, 3).Copy ThisWorkbook.Sheets("sheet2").Range("C" & i)
        Dwb.Close False
    Next
End Sub

Thank you. I will try...

 

[jasmin10]

This will loop through Column B and get the info.
Check `Rng.Offset(, 3).Value` it may need to change the offset to 2

Sub LoopThroughFolder()
    Dim c As Range, MyRng As Range
    Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
    Dim Rng As Range, sh As Worksheet
   
    Set Wb = ThisWorkbook
    Set sh = Wb.Sheets(1)     'first sheet in workbook
 
    MyDir = "C:\Users\davem\Downloads\WorkBookLoop\"  'change the address to suite
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    With sh
        Set MyRng = .Range("B2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
        For Each c In MyRng.Cells

            MyFile = Dir(MyDir & c & ".xls")     'change file extension
            ChDir MyDir
           
            Workbooks.Open (MyFile)

            With Worksheets("Sheet1")
                Set Rng = .Cells.Find("NÜFUS")
                If Not Rng Is Nothing Then
                    With sh
                        .Cells(.Rows.Count, "C").End(xlUp).Offset(1).Value = Rng.Offset(, 3).Value
                    End With
                End If
                ActiveWorkbook.Close True
            End With

            MyFile = Dir()
        Next c
       
    End With
   
    Wb.Save
End Sub

Thank you again. I tried. ChDir MyDir gave error as "path not found". I changed C:\Users\davem\Downloads\WorkBookLoop\ into "E:\BIST\DATA\FINANSALLAR\2009-09\" and in the computer the address is as: E:\BIST\DATA\FINANSALLAR\2009-09. I dont know why it does not work.

 

[davesexcel]

Should also start on B3 not B2

 

[jasmin10]

Should also start on B3 not B2

I did. What should I do, I do not know. My main excel contains 518 excel names, but my first folder contains only 300 something. Might the reason be that? What shoul I do? By the way thank you for your helps.

 

[jasmin10]

May be

Sub test()
    Dim i As Long
    Dim Dwb As Workbook
    Dim fnd As Range
    For i = 3 To 503
        Set Dwb = Workbooks.Open("E:\BIST\DATA\FINANSALLAR\2009-12\" & b(i) & ".xls*")
        Set Dwb = ActiveWorkbook
        Set fnd = Dwb.Sheets(1).Range("A:A").Find(what:="xxx", LookIn:=xlValues, lookat:=xlWhole)
        fnd.Offset(, 3).Copy ThisWorkbook.Sheets("sheet2").Range("C" & i)
        Dwb.Close False
    Next
End Sub

Thank you for your help. It gives a define error for & b(i).

 

[davesexcel]

Your first post say the folder is.
E:\BIST\DATA\FINANSALLAR\2009-12\