I want to open multiple workbooks one by one which are in a folder on my
pc and then do vlookup based on the master file which is aready kept
open by me.there are around 700 workbooks, so opening each one by one
and doing Vlookup is a tedious task. Can anyone provide a solution macro
for this wherein all the files get open automatically one by one and
vlookup is done on them ??? after its done the file must be saved a nd
closed automatically.


--
luckyros
------------------------------------------------------------------------
luckyros's Profile: http://www.thecodecage.com/forumz/member.php?userid=337
View this thread: http://www.thecodecage.com/forumz/sh...ad.php?t=98732

Hi Luckyros,

Are all the workbooks in the same folder (directory).
Do all the workbooks share a similar filename so that part of the name and a
wildcard can be used to find them? Like MyFileName*.xls. If so, what is the
filename to use?

Please answer the above then you can help some more by recording a macro.
This is the best way of telling us what you want to do.
Open the master file.
Turn on macro recorder.
Open one of the files.
Select the required worksheet. (If already selected, select another
worksheet and re-select the required worksheet.)
Select the cell for the Vlookup formula.
Insert the Vlookup Formula (and copy it down if necessary.)
Save the workbook.
Stop macro recorder and then copy and post the recorded macro.

If you want the formula copied down to other cells then need to know if all
workbooks have the same number of rows. If not, then nominate a column that
will always have data in the last row.


--
Regards,

OssieMac


"luckyros" wrote:


I want to open multiple workbooks one by one which are in a folder on my
pc and then do vlookup based on the master file which is aready kept
open by me.there are around 700 workbooks, so opening each one by one
and doing Vlookup is a tedious task. Can anyone provide a solution macro
for this wherein all the files get open automatically one by one and
vlookup is done on them ??? after its done the file must be saved a nd
closed automatically.


--
luckyros
------------------------------------------------------------------------
luckyros's Profile: http://www.thecodecage.com/forumz/member.php?userid=337
View this thread: http://www.thecodecage.com/forumz/sh...ad.php?t=98732

Yes all the workbooks are in the same folder. The work book name starts
with "Agent Call*.xlsx".

Following is the macro i have recorded.

Sub Macro2()
'
' Macro2 Macro
'

'
Workbooks.Open Filename:= _
"E:\New Folder (2)\Agent Call
Report_051609_164502_anactan.xlsx"
Sheets("Agent Call Report_051609_164502").Select
Range("G1").Select
ActiveCell.FormulaR1C1 = "Team Leader"
Range("G2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-6],'[Master Database.xlsx]Sheet1'!C1:C2,2,0)"
Selection.Copy
Range("F2").Select
Selection.End(xlDown).Select
Range("G34").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.End(xlUp).Select
Range("G2").Select
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close
End Sub



I want this steps to be done for all the workbooks in the folder
automatically.


--
luckyros
------------------------------------------------------------------------
luckyros's Profile: http://www.thecodecage.com/forumz/member.php?userid=337
View this thread: http://www.thecodecage.com/forumz/sh...ad.php?t=98732

Hi again Luckyros,

Got most of it done. The numbers in the workbook name and the worksheet name
I am assuming change with each workbook and that the worksheet numbers match
the numbers in the workbook name. Is this correct?

If my assumprion is not correct then which part of the workbook name and the
worksheet name changes? Show it like the following where the question marks
indicate the characters that are variable.

Workbook Name:
Agent Call Report_??????_??????_anactan.xlsx

Worksheet name:
Agent Call Report_??????_??????

It's 11pm here now so will not get back to it until tomorrow.

--
Regards,

OssieMac

Hellow again Luckyros,

As I have not had a reply to my last question (probably due to time
differences and you are in bed) so I have assumed that the Worksheet name
follows the Workbook name and prepared the code on that basis. If my
assumption is not correct then if you answer my previous post then I will
modify the code.

You need to copy the code into your Workbook Master Database and then save
the workbook as a macro enabled workbook (Master Database.xlsm).

CAUTION:
In case the program does not return the expected results, copy all of your
workbooks, including Master database into a new directory so that you are not
working on the originals. Does not matter what the directory name is so long
as all the files are in the same directory because the program identifies the
directory of the workbook with the program.

Suggestion:
Initially only copy Master database and about 5 of the other files and then
run the code and check if you are getting the results expected. If all OK
then copy all of the files including overwriting the test ones. (Don't try
to re-run code on files already processed).

The program adds a worksheet to Master database and creates a list of the
files to be processed. As they are processed, "Yes" is inserted in the column
beside the filename. I did this because one never knows if Excel will crash
during the run and if this occurs, you can check what files are processed and
move them to another directory and re-run the program on the remaining files.
(You may need to sort the file list because Dir() does not necessarily
collect the files in sorted order.)

The worksheet with the file list can be deleted after the code has been run.
However, if not deleted, the code adds another one.

Sub InsertFormulas()

Dim strInitPath As String
Dim strFilename As String
Dim strPathAndFile As String
Dim strFileCriteria As String
Dim wsFileList As Worksheet
Dim strVlookupSht As String
Dim intPosLast As Integer
Dim wbOpenWb As Workbook
Dim wsVlookupSht As Worksheet
Dim rngFileList As Range
Dim c As Range

strInitPath = ThisWorkbook.Path
'Can edit and use actual path string
'strInitPath = "E:\New Folder (2)\"

strFileCriteria = "Agent Call*.xlsx"

'Set file search criteria
strPathAndFile = strInitPath & "\" & _
strFileCriteria

'Add new sheet this workbook for filenames
ThisWorkbook.Sheets.Add After:=Sheets(Sheets.Count)
Set wsFileList = ThisWorkbook.ActiveSheet

'Retrieve the first filename.
strFilename = Dir(strPathAndFile)

'Save filenames to new worksheet this workbook
With wsFileList
.Range("A1") = "File Names"
.Range("B1") = "Processed"

Do While strFilename < ""
.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0) = strFilename
strFilename = Dir()
Loop

Set rngFileList = .Range(.Cells(2, 1), _
.Cells(.Rows.Count, 1).End(xlUp))

.Columns("A:B").AutoFit
End With

For Each c In rngFileList
Workbooks.Open Filename:=strInitPath _
& "\" & c.Value

Set wbOpenWb = ActiveWorkbook
'Identify worksheet name from Workbook name
intPosLast = InStrRev(c.Value, "_") - 1
strVlookupSht = Left(c.Value, intPosLast)
'Assign worksheet to a variable
Set wsVlookupSht = _
wbOpenWb.Sheets(strVlookupSht)

With wsVlookupSht
.Range("G1").FormulaR1C1 = "Team Leader"
.Range("G2").FormulaR1C1 = _
"=VLOOKUP(RC[-6]," & _
"'[Master Database.xlsm]Sheet1'!C1:C2,2,0)"

.Range("G2").Copy _
Destination:=.Range(.Cells(2, 7), _
.Cells(2, 6).End(xlDown).Offset(0, 1))

.Range(.Cells(2, 7), _
.Cells(2, 6).End(xlDown).Offset(0, 1)).Copy

.Cells(2, 7).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False

Application.CutCopyMode = False
wbOpenWb.Save
wbOpenWb.Close
End With
c.Offset(0, 1) = "Yes"
Next
End Sub

--
Regards,

OssieMac

My workbook name will change but the worksheet name will be same. The
worksheet name will be sheet1 only and not anytrhing else. Since these
are dummy files i forgot to change the sheet name to sheet1.

When i run this macro the first file gets processed correctly but then
an error occurs stating "Run-time error '9': Subscription out of range".
and when i debug the line which gets highlighted in Yellow is "Set
wsVlookupSht = _
wbOpenWb.Sheets(strVlookupSht)".

What may be the problem ?


--
luckyros
------------------------------------------------------------------------
luckyros's Profile: http://www.thecodecage.com/forumz/member.php?userid=337
View this thread: http://www.thecodecage.com/forumz/sh...ad.php?t=98732

OK Luckyros. We try again.

The error is due to the wrong sheet name.

Replace all of your code with following. Was going to explain to you which
lines to replace but replace the lot is easier.

Sub InsertFormulas()

Dim strInitPath As String
Dim strFilename As String
Dim strPathAndFile As String
Dim strFileCriteria As String
Dim wsFileList As Worksheet
Dim strVlookupSht As String
Dim intPosLast As Integer
Dim wbOpenWb As Workbook
Dim wsVlookupSht As Worksheet
Dim rngFileList As Range
Dim c As Range

strInitPath = ThisWorkbook.Path
'Can edit and use actual path string
'strInitPath = "E:\New Folder (2)\"

strFileCriteria = "Agent Call*.xlsx"

'Set file search criteria
strPathAndFile = strInitPath & "\" & _
strFileCriteria

'Add new sheet this workbook for filenames
ThisWorkbook.Sheets.Add After:=Sheets(Sheets.Count)
Set wsFileList = ThisWorkbook.ActiveSheet

'Retrieve the first filename.
strFilename = Dir(strPathAndFile)

'Save filenames to new worksheet this workbook
With wsFileList
.Range("A1") = "File Names"
.Range("B1") = "Processed"

Do While strFilename < ""
.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0) = strFilename
strFilename = Dir()
Loop

Set rngFileList = .Range(.Cells(2, 1), _
.Cells(.Rows.Count, 1).End(xlUp))

.Columns("A:B").AutoFit
End With

For Each c In rngFileList
Workbooks.Open Filename:=strInitPath _
& "\" & c.Value

'Assign workbook to a variable
Set wbOpenWb = ActiveWorkbook

'Assign worksheet to a variable
Set wsVlookupSht = _
wbOpenWb.Sheets("Sheet1")

With wsVlookupSht
.Range("G1").FormulaR1C1 = "Team Leader"
.Range("G2").FormulaR1C1 = _
"=VLOOKUP(RC[-6]," & _
"'[Master Database.xlsm]Sheet1'!C1:C2,2,0)"

.Range("G2").Copy _
Destination:=.Range(.Cells(2, 7), _
.Cells(2, 6).End(xlDown).Offset(0, 1))

.Range(.Cells(2, 7), _
.Cells(2, 6).End(xlDown).Offset(0, 1)).Copy

.Cells(2, 7).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False

Application.CutCopyMode = False
wbOpenWb.Save
wbOpenWb.Close
End With
c.Offset(0, 1) = "Yes"
Next
End Sub

--
Regards,

OssieMac

When i run this program it gives error stating "Compile Error : Invalid
or unqualified reference" and ".Range("A1") =" is selected in blue.


Also "Set rngFileList = .Range(.Cells(2, 1), _ .Cells(.Rows.Count,
1).End(xlUp))"

and ".Cells(2, 7).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, _ Transpose:=False"

are shown in Red when i paste the code in a module.


--
luckyros
------------------------------------------------------------------------
luckyros's Profile: http://www.thecodecage.com/forumz/member.php?userid=337
View this thread: http://www.thecodecage.com/forumz/sh...ad.php?t=98732

Hi again Luckyros,

There appears to be something strange occurring with this thread. I am
accessing it via microsoft communities and I am not getting my email
notifications of replies and for the errors you are getting some line feeds
are getting lost or line breaks occurring at the incorrect place. (I have
been periodically searching for the thread so that I can see your replies
because of no notifications.)

Anyway, to try and explain. A space and an underscore at the end of a line
is a line break in an otherwise single line of code. When used the line must
be broken after the underscore and restart on the next line. (Breaking a line
between double quotes is a bit more complex but I won't go into that now.)

When code is pasted into the VBA editor and a line appears in red it is
because a line has broken at point that is not immediately after the space
and underscore. The fix is to go to the end of the first red line and keep
pressing the delete key until the following line comes up to join the line.
You might have to do it to following lines but the trick is to recognise
whether it is a single line of code with line breaks or start of another
line. Can be difficult if you can't follow the code.

It is not unusual for long lines of code to break in these posts. I always
use line breaks with a view to alleviating breaking in the wrong place.
Although I always use double spacing at strategic places in the code to make
it easier to read and understand, I am wondering if the double spacing I used
is playing havoc with line breaks.

The following code has the longer lines of code broken with line breaks and
I have removed all double spacing. Replace all of your code with it.

I have tested as much I can and the code appears to be working. If you can't
get it working, if you want to get an hotmail (or other provider) email
address that you can abandon later (if getting too much spam) and you post
the address I will reply to you and then if you like you can email me your
master file and one of the other files to be updated. I can make multiple
copies of the one to be updated. I will then get it working for you.

Sub InsertFormulas()
Dim strInitPath As String
Dim strFilename As String
Dim strPathAndFile As String
Dim strFileCriteria As String
Dim wsFileList As Worksheet
Dim wbOpenWb As Workbook
Dim wsVlookupSht As Worksheet
Dim rngFileList As Range
Dim c As Range
strInitPath = ThisWorkbook.Path
'Can edit and use actual path string
'strInitPath = "E:\New Folder (2)\"
strFileCriteria = "Agent Call*.xlsx"
'Set file search criteria
strPathAndFile = strInitPath & "\" & _
strFileCriteria
'Add new sheet this workbook
ThisWorkbook.Sheets.Add After:= _
Sheets(Sheets.Count)
Set wsFileList = ThisWorkbook.ActiveSheet
'Retrieve the first filename.
strFilename = Dir(strPathAndFile)
'Save filenames to new worksheet
With wsFileList
.Range("A1") = "File Names"
.Range("B1") = "Processed"
Do While strFilename < ""
.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0) _
= strFilename
strFilename = Dir()
Loop
Set rngFileList = .Range _
(.Cells(2, 1), .Cells _
(.Rows.Count, 1).End(xlUp))
.Columns("A:B").AutoFit
End With
For Each c In rngFileList
Workbooks.Open Filename:= _
strInitPath & "\" & c.Value
'Assign workbook to a variable
Set wbOpenWb = ActiveWorkbook
'Assign worksheet to a variable
Set wsVlookupSht = _
wbOpenWb.Sheets("Sheet1")
With wsVlookupSht
.Range("G1").FormulaR1C1 = _
"Team Leader"
.Range("G2").FormulaR1C1 = _
"=VLOOKUP(RC[-6]," & _
"'[Master Database.xlsm]Sheet1'" _
& "!C1:C2,2,0)"
.Range("G2").Copy _
Destination:=.Range _
(.Cells(2, 7), _
.Cells(2, 6).End(xlDown) _
.Offset(0, 1))
.Range(.Cells(2, 7), _
.Cells(2, 6).End(xlDown) _
.Offset(0, 1)).Copy
.Cells(2, 7).PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Application.CutCopyMode = False
wbOpenWb.Save
wbOpenWb.Close
End With
c.Offset(0, 1) = "Yes"
Next

--
Regards,

OssieMac

One more commment. If you see a space and an underscore in the middle of a
line that is red, place the cursor to the right of the underscore and press
enter to force the remaining code to the next line.

--
Regards,

OssieMac