Hi all, I am using excel 2007. I have list of files names in column A
of Sheet1 like (see below)

A ------column
Record A
Record B
Record C
etc….

All the names listed in column A are the names of the files which are
in Folder "C:\Document\Data". I want macro assigned to a button in
Sheet1 which should Match or Lookup files names listed in column A of
Sheet1 with names of files which are in above Folder. And if there
are new files been saved in Folder which names are not listed in
column A of Sheet1 then macro should open them one by one and copy
cell B2 value from those files and paste it in column B of Sheet1 and
Put that file name without extension below the last value cell of
column A and then close those files. Please can any friend can help
as i need simple and small macro if possible and i been asking this
question from two weeks but didnt have any accurate answer.

I didn't see this posting before. It is very simple

Sub getfiles()

Folder = "C:\Document\Data\"


FName = Dir(Folder & "*.xls")

LastRow = Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1

Do While FName < ""
Set c = Columns("A").Find(what:=FName, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
Set bk = Workbooks.Open(Filename:=Folder & FName)
With bk.Sheets(1)
Data = .Range("B2")
.Range("A" & NewRow) = FName
.Range("B" & NewRow) = Data
NewRow = NewRow + 1
End With
bk.Close savechanges:=False
End If

FName = Dir()
Loop


End Sub



"K" wrote:

Hi all, I am using excel 2007. I have list of files names in column A
of Sheet1 like (see below)

A ------column
Record A
Record B
Record C
etc€¦.

All the names listed in column A are the names of the files which are
in Folder "C:\Document\Data". I want macro assigned to a button in
Sheet1 which should Match or Lookup files names listed in column A of
Sheet1 with names of files which are in above Folder. And if there
are new files been saved in Folder which names are not listed in
column A of Sheet1 then macro should open them one by one and copy
cell B2 value from those files and paste it in column B of Sheet1 and
Put that file name without extension below the last value cell of
column A and then close those files. Please can any friend can help
as i need simple and small macro if possible and i been asking this
question from two weeks but didnt have any accurate answer.

Hi

Insert this code in an ordinary module and call it from the
CommandButton. As I assume there is only Excel files in the directory,
the macro doesn't check the file type. This will cause an error if I
am wrong, but the test can be incorporated in this code.

Sub AAA()
Dim wbA As Workbook
Dim wbB As Workbook
Dim shA As Worksheet
Dim shB As Worksheet
Dim TargetRange As Range
Dim FileNam As String
Dim FileNam1 As String
Dim TargetFol As String

Set wbA = ActiveWorkbook
Set shA = wbA.Worksheets("Sheet1")
TargetFol = "C:\Document\Data\"

FileNam = Dir(TargetFol)

Do Until FileNam = ""
Set TargetRange = shA.Range("A1", shA.Range("A1").End(xlDown))
FileNam1 = Left(FileNam, WorksheetFunction.Find(".", FileNam) - 1)
Set f = TargetRange.Find(what:=FileNam1, lookat:=xlWhole)
If f Is Nothing Then
Set wbB = Workbooks.Open(Filename:=TargetFol & FileNam)
Set shB = wbB.Worksheets("Sheet1")
DestRow = shA.Range("A1").End(xlDown).Row + 1
shB.Range("B2").Copy shA.Range("B" & DestRow)
shA.Range("A" & DestRow) = FileNam1
wbB.Close
End If
FileNam = Dir
Loop
End Sub

Regards,
Per

On 17 Mar., 17:53, K wrote:
Hi all, I am using excel 2007. *I have list of files names in column A
of Sheet1 like (see below)

* * * A ------column
Record A
Record B
Record C
etc….

All the names listed in column A are the names of the files which are
in Folder "C:\Document\Data". *I want macro assigned to a button in
Sheet1 which should Match or Lookup files names listed in column A of
Sheet1 with names of files which are in above Folder. *And if there
are new files been saved in Folder which names are not listed in
column A of Sheet1 then macro should open them one by one and copy
cell B2 value from those files and paste it in column B of Sheet1 and
Put that file name without extension below the last value cell of
column A and then close those files. *Please can any friend can help
as i need simple and small macro if possible and i been asking this
question from two weeks but didnt have any accurate answer.

On Mar 17, 10:52*pm, Joel wrote:
I didn't see this posting before. *It is very simple

Sub getfiles()

Folder = "C:\Document\Data\"

FName = Dir(Folder & "*.xls")

LastRow = Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1

Do While FName < ""
* *Set c = Columns("A").Find(what:=FName, _
* * * LookIn:=xlValues, lookat:=xlWhole)
* *If c Is Nothing Then
* * * Set bk = Workbooks.Open(Filename:=Folder & FName)
* * * With bk.Sheets(1)
* * * * *Data = .Range("B2")
* * * * *.Range("A" & NewRow) = FName
* * * * *.Range("B" & NewRow) = Data
* * * * *NewRow = NewRow + 1
* * * End With
* * * bk.Close savechanges:=False
* *End If

* *FName = Dir()
Loop

End Sub



"K" wrote:
Hi all, I am using excel 2007. *I have list of files names in column A
of Sheet1 like (see below)

* * * A ------column
Record A
Record B
Record C
etc….

All the names listed in column A are the names of the files which are
in Folder "C:\Document\Data". *I want macro assigned to a button in
Sheet1 which should Match or Lookup files names listed in column A of
Sheet1 with names of files which are in above Folder. *And if there
are new files been saved in Folder which names are not listed in
column A of Sheet1 then macro should open them one by one and copy
cell B2 value from those files and paste it in column B of Sheet1 and
Put that file name without extension below the last value cell of
column A and then close those files. *Please can any friend can help
as i need simple and small macro if possible and i been asking this
question from two weeks but didnt have any accurate answer.- Hide quoted text -

- Show quoted text -

thanks

On Mar 17, 10:52*pm, Joel wrote:
I didn't see this posting before. *It is very simple

Sub getfiles()

Folder = "C:\Document\Data\"

FName = Dir(Folder & "*.xls")

LastRow = Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1

Do While FName < ""
* *Set c = Columns("A").Find(what:=FName, _
* * * LookIn:=xlValues, lookat:=xlWhole)
* *If c Is Nothing Then
* * * Set bk = Workbooks.Open(Filename:=Folder & FName)
* * * With bk.Sheets(1)
* * * * *Data = .Range("B2")
* * * * *.Range("A" & NewRow) = FName
* * * * *.Range("B" & NewRow) = Data
* * * * *NewRow = NewRow + 1
* * * End With
* * * bk.Close savechanges:=False
* *End If

* *FName = Dir()
Loop

End Sub



"K" wrote:
Hi all, I am using excel 2007. *I have list of files names in column A
of Sheet1 like (see below)

* * * A ------column
Record A
Record B
Record C
etc….

All the names listed in column A are the names of the files which are
in Folder "C:\Document\Data". *I want macro assigned to a button in
Sheet1 which should Match or Lookup files names listed in column A of
Sheet1 with names of files which are in above Folder. *And if there
are new files been saved in Folder which names are not listed in
column A of Sheet1 then macro should open them one by one and copy
cell B2 value from those files and paste it in column B of Sheet1 and
Put that file name without extension below the last value cell of
column A and then close those files. *Please can any friend can help
as i need simple and small macro if possible and i been asking this
question from two weeks but didnt have any accurate answer.- Hide quoted text -

- Show quoted text -

just small question that how can i change the code if files are in
subfolders

I'm not sure if you want to search both main folder and subfolder. I only
did subfolders. Also I'm just searching for the basic filename (doesn't
include folders) when looking for file on the worksheet.

Sub getfiles()

FolderName = "C:\Document\Data"
FolderName = "C:\Temp"

Set fs = CreateObject("Scripting.FileSystemObject")
Set Folder = fs.GetFolder(FolderName)

LastRow = Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1

For Each Subfld In Folder.subfolders

FName = Dir(Subfld & "\" & "*.xls")

Do While FName < ""
Set c = Columns("A").Find(what:=FName, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
Set bk = Workbooks.Open(Filename:=Subfld & "\" & FName)
With bk.Sheets(1)
Data = .Range("B2")
.Range("A" & NewRow) = FName
.Range("B" & NewRow) = Data
NewRow = NewRow + 1
End With
bk.Close savechanges:=False
End If

FName = Dir()
Loop
Next Subfld

End Sub




"K" wrote:

On Mar 17, 10:52 pm, Joel wrote:
I didn't see this posting before. It is very simple

Sub getfiles()

Folder = "C:\Document\Data\"

FName = Dir(Folder & "*.xls")

LastRow = Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1

Do While FName < ""
Set c = Columns("A").Find(what:=FName, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
Set bk = Workbooks.Open(Filename:=Folder & FName)
With bk.Sheets(1)
Data = .Range("B2")
.Range("A" & NewRow) = FName
.Range("B" & NewRow) = Data
NewRow = NewRow + 1
End With
bk.Close savechanges:=False
End If

FName = Dir()
Loop

End Sub



"K" wrote:
Hi all, I am using excel 2007. I have list of files names in column A
of Sheet1 like (see below)

A ------column
Record A
Record B
Record C
etc€¦.

All the names listed in column A are the names of the files which are
in Folder "C:\Document\Data". I want macro assigned to a button in
Sheet1 which should Match or Lookup files names listed in column A of
Sheet1 with names of files which are in above Folder. And if there
are new files been saved in Folder which names are not listed in
column A of Sheet1 then macro should open them one by one and copy
cell B2 value from those files and paste it in column B of Sheet1 and
Put that file name without extension below the last value cell of
column A and then close those files. Please can any friend can help
as i need simple and small macro if possible and i been asking this
question from two weeks but didnt have any accurate answer.- Hide quoted text -

- Show quoted text -

thanks

On Mar 18, 10:16*am, Joel wrote:
I'm not sure if you want to search both main folder and subfolder. *I only
did subfolders. *Also I'm just searching for the basic filename (doesn't
include folders) when looking for file on the worksheet.

Sub getfiles()

FolderName = "C:\Document\Data"
FolderName = "C:\Temp"

Set fs = CreateObject("Scripting.FileSystemObject")
Set Folder = fs.GetFolder(FolderName)

LastRow = Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1

For Each Subfld In Folder.subfolders

* *FName = Dir(Subfld & "\" & "*.xls")

* *Do While FName < ""
* * * Set c = Columns("A").Find(what:=FName, _
* * * * *LookIn:=xlValues, lookat:=xlWhole)
* * * If c Is Nothing Then
* * * * *Set bk = Workbooks.Open(Filename:=Subfld & "\" & FName)
* * * * *With bk.Sheets(1)
* * * * * * Data = .Range("B2")
* * * * * * .Range("A" & NewRow) = FName
* * * * * * .Range("B" & NewRow) = Data
* * * * * * NewRow = NewRow + 1
* * * * *End With
* * * * *bk.Close savechanges:=False
* * * End If

* * * FName = Dir()
* *Loop
Next Subfld

End Sub



"K" wrote:
On Mar 17, 10:52 pm, Joel wrote:
I didn't see this posting before. *It is very simple

Sub getfiles()

Folder = "C:\Document\Data\"

FName = Dir(Folder & "*.xls")

LastRow = Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1

Do While FName < ""
* *Set c = Columns("A").Find(what:=FName, _
* * * LookIn:=xlValues, lookat:=xlWhole)
* *If c Is Nothing Then
* * * Set bk = Workbooks.Open(Filename:=Folder & FName)
* * * With bk.Sheets(1)
* * * * *Data = .Range("B2")
* * * * *.Range("A" & NewRow) = FName
* * * * *.Range("B" & NewRow) = Data
* * * * *NewRow = NewRow + 1
* * * End With
* * * bk.Close savechanges:=False
* *End If

* *FName = Dir()
Loop

End Sub

"K" wrote:
Hi all, I am using excel 2007. *I have list of files names in column A
of Sheet1 like (see below)

* * * A ------column
Record A
Record B
Record C
etc….

All the names listed in column A are the names of the files which are
in Folder "C:\Document\Data". *I want macro assigned to a button in
Sheet1 which should Match or Lookup files names listed in column A of
Sheet1 with names of files which are in above Folder. *And if there
are new files been saved in Folder which names are not listed in
column A of Sheet1 then macro should open them one by one and copy
cell B2 value from those files and paste it in column B of Sheet1 and
Put that file name without extension below the last value cell of
column A and then close those files. *Please can any friend can help
as i need simple and small macro if possible and i been asking this
question from two weeks but didnt have any accurate answer.- Hide quoted text -

- Show quoted text -

thanks- Hide quoted text -

- Show quoted text -

Thats brilliant Joel. Thanks lot