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
