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

jasmin10

New Member
Joined
Jan 2, 2021
Messages
11
Office Version
  1. 365
Platform
  1. Windows
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...
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney

davesexcel

Well-known Member
Joined
Feb 26, 2006
Messages
1,089
This will loop through Column B and get the info.
Check `Rng.Offset(, 3).Value` it may need to change the offset to 2
VBA Code:
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

Well-known Member
Joined
Mar 22, 2015
Messages
1,091
Office Version
  1. 2013
Platform
  1. Windows
May be
VBA Code:
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

New Member
Joined
Jan 2, 2021
Messages
11
Office Version
  1. 365
Platform
  1. Windows
This will loop through Column B and get the info.
Check `Rng.Offset(, 3).Value` it may need to change the offset to 2
VBA Code:
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

New Member
Joined
Jan 2, 2021
Messages
11
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

May be
VBA Code:
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

New Member
Joined
Jan 2, 2021
Messages
11
Office Version
  1. 365
Platform
  1. Windows
This will loop through Column B and get the info.
Check `Rng.Offset(, 3).Value` it may need to change the offset to 2
VBA Code:
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

Well-known Member
Joined
Feb 26, 2006
Messages
1,089

ADVERTISEMENT

Should also start on B3 not B2
 

jasmin10

New Member
Joined
Jan 2, 2021
Messages
11
Office Version
  1. 365
Platform
  1. Windows
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

New Member
Joined
Jan 2, 2021
Messages
11
Office Version
  1. 365
Platform
  1. Windows
May be
VBA Code:
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

Well-known Member
Joined
Feb 26, 2006
Messages
1,089
Your first post say the folder is.
E:\BIST\DATA\FINANSALLAR\2009-12\
 

Watch MrExcel Video

Forum statistics

Threads
1,129,323
Messages
5,635,603
Members
416,869
Latest member
JeffK26

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
Top