VBScript : perform a VBA function with excel Application object

Hello Experts,

 I use in VBA the following excellent procedure which allows me to perform Index Match based on certain parameters:

Sub DoIndexMatch(Target As Range, matchvalue As Range, comparedvalue As Range, DestinationColumn As String)
    Dim c As Range
    For Each c In matchvalue
        If IsNumeric(Application.Match(c, comparedvalue, 0)) Then
            Range(DestinationColumn & c.Row) = Application.WorksheetFunction.Index(Target, Application.WorksheetFunction.Match(c, comparedvalue, 0), 0)
        End If
    Next c
End Sub

Sub RunIndexMatch()
    DoIndexMatch Range("ccprojectstable!v2:v" & Rows.Count), Range("E2", Range("E" & Rows.Count).End(xlUp)), Range("ccprojectstable!A2:A" & Rows.Count), "B"
    DoIndexMatch Range("accountingtable!F2:F" & Rows.Count), Range("E2", Range("E" & Rows.Count).End(xlUp)), Range("accountingtable!A2:A" & Rows.Count), "O"
End Sub

Open in new window



I would like to convert this procedure with by using Excel Application

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.WorkSheet
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)

In order to:

Be able to perform IndexMatch across two Workbooks and not two Worksheets as it is set up in my procedure.
Be able to open the files concerned by the indexmatch with vbscript language : most recent, file name string etc.
Be able to initialize the action outside excel even if we call ExcelApplication it will be a vbs which initialize the action
Be able to log activities

The idea is to:

1-Open Destination Workbook based on a specified directory if it is already open skip this action
2-Open Source Workbook based on a specified directory if it is already open skip this action

Destination and Source Workbooks can be in a different directory.

3- Call the indexmatch action in which I should be able to specified:

-SourceWorkbookTargetRange: reference Target Range that will be "transferred" to the Destination Workbook that will receive the Index.Match
-DestinationWorkbookComparedRange:  compared range that will be used in the destination workbook to be able to transfertSourceWorkbookTargetRange
-SourceWorkbookMatchRange : this Range will be used after the  comparison with the DestinationWorkbookComparedRange in order to perform the Index Match
-DestinationWorkbookColumn: this is the Column that will receive the Target in DestinationWorkbook comming from SourceWorkbookTargetRange

4-Save and close the both files.

Log activities:

If DestinationWorkbooks and SourceWorkbook doesn't exist, exit sub
If DestinationWorkbook cannot be saved, exit sub


Thank you very much for your help.
LVL 1
LD16Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

crystal (strive4peace) - Microsoft MVP, AccessRemote Training and ProgrammingCommented:
I was going to look at this but ran out of time today.

I think there is a problem with what you posted ... I believe that
Application.Match
should be
Application.WorksheetFunction.Match
1
LD16Author Commented:
Thank you for your comment:

Here is an example with two worksheets and the Application.Match works

Regards,
Do-Index-Match-Excel-Application-Ob.xlsm
0
LD16Author Commented:
Okey, here is an approach that cover some requirements based on the files attached.

I took as a reference the question available at :

http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_26685812.html


Sub IndexMatch()

Dim objExcel,objWB1Name,objWB2Name,objWB1, objWB2, objWS1, objWS2

strPath = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True

objWB1Name = "File1.xlsx"
objWB2Name = "File2.xlsx"

Set objWB1 = objExcel.Workbooks.Open(strPath & objWB1Name)
Set objWS1 = objWB1.Sheets(1)

Set objWB2 = objExcel.Workbooks.Open(strPath & objWB2Name)
Set objWS2 = objWB2.Sheets(1)

'objWS2.Columns(4).Insert

objWS2.Range("F1:F" & objWS2.UsedRange.Rows.Count).Formula = "=INDEX(File1.xlsx!$B:$B,MATCH($C:$C,File1.xlsx!$A:$A,0))"
'objWS2.Range("D1:D" & objWS2.UsedRange.Rows.Count).Formula = "=VLOOKUP(INDEX(C:C,ROW()),File1.xlsx!$A:$B,2)"
objWS2.Range("F1:F" & objWS2.UsedRange.Rows.Count).Formula = objWS2.Range("F1:F" & objWS2.UsedRange.Rows.Count).Value


objWB2.Save
objWB2.Close false
objWB1.Close false

objExcel.Quit

End Sub

Call IndexMatch()

Open in new window

File1.xlsx
File2.xlsx
0
Cloud Class® Course: Python 3 Fundamentals

This course will teach participants about installing and configuring Python, syntax, importing, statements, types, strings, booleans, files, lists, tuples, comprehensions, functions, and classes.

LD16Author Commented:
Okey here is a code that will cover my requirements :


' File I/O constants
Const ForAppending = 8

'Create the file system object
Set objFSO = CreateObject("Scripting.FileSystemObject")

strPath = Replace(WScript.ScriptFullName, WScript.ScriptName, "")


Call IndexMatch(strPath,strPath,"File1.xlsx","File2.xlsx","F1:F","B1:B","C1:C","A1:A")


Sub IndexMatch(strPathobjWB1,strPathobjWB2,strWB1Name,strWB2Name,_
strDesintationRange,strIndexRange,strMatchRange,strComparedRange)

' Variables are : 

' Path of your File1 which have the Target Range
' Patch of your File2 which will receive the IndexMatch formula
' strDestinationRange is the Range which will receive the Formula located in strWB2Name
' strIndexRange is the Range that you want to bring located in strWB1Name
' strMatchRange is your Key Range located in the same Workbook that strDestinationRange located in strWB2Name
' strComparedRange is the Range to compared with your strMatchRange located in the same workbook that your strIndexRange located in strWB1Name

Dim objExcel,objWB1Name,objWB2Name,objWB1,_ 
objWB2, objWS1, objWS2

' Excel application definition
Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True

' Set your Workbooks name
objWB1Name = strWB1Name
objWB2Name = strWB2Name

' Open File 1 and File 2

Set objWB1 = objExcel.Workbooks.Open(strPathobjWB1 & objWB1Name)
Set objWS1 = objWB1.Sheets(1)

Set objWB2 = objExcel.Workbooks.Open(strPathobjWB2 & objWB2Name)
Set objWS2 = objWB2.Sheets(1)

' Perform Index Match formula

objWS2.Range(strDesintationRange & objWS2.UsedRange.Rows.Count)=_ 
objExcel.WorksheetFunction.Index(objWS1.Range(strIndexRange & objWS1.UsedRange.Rows.Count),_ 
objExcel.WorksheetFunction.Match(objWS2.Range(strMatchRange & objWS2.UsedRange.Rows.Count),_ 
objWS1.Range(strComparedRange & objWS1.UsedRange.Rows.Count),0))


' Save File 2 and close File 1 and File 2
objWB2.Save
objWB2.Close false
objWB1.Close false

objExcel.Quit

End Sub

Open in new window


I have some questions:

Should I applied the For each loop? already mentioned before or not?
How should I exclude the "NA" values I tried the ISNA formula but it doesn't work.

If any experts have some feedback concerning the code above please let me know.
0
crystal (strive4peace) - Microsoft MVP, AccessRemote Training and ProgrammingCommented:
how about IsError?

not sure I understand the loop question ...
0
crystal (strive4peace) - Microsoft MVP, AccessRemote Training and ProgrammingCommented:
also, there should be more release statements
   objWB2.Save
   objWB2.Close False
   objWB1.Close False
   
   Set objWB1 = Nothing
   Set objWB2 = Nothing
   
   objExcel.Quit
   Set objExcel = Nothing

Open in new window


... and a space before the _ to continue a statement on the next line

Dim strPath  as String
~~~~
objFSO  needs to be DIMmed and
   set objFSO = nothing

I would also Dim objExcel as Object as well as the rest of the objects, just to be clear.
0
crystal (strive4peace) - Microsoft MVP, AccessRemote Training and ProgrammingCommented:
rearranged your code a bit ... how is this?  It is still not done.  Once you explain how you are determining the files to get, it can be modified.  Right now, it is set up to just do one ... didn't test it ~ and you can do that too ~
Option Explicit

Sub callingcode()
   Const ForAppending = 8
'151122 strive4peace modified NOT DONE --
'1. Load filenames into an array
'2. Loop through the array
'3. perform operation

   Dim strPath As String _
      , iIndex As Integer
   
   Dim arrPath() As String _
      , arrFile1() As String _
      , arrFile2() As String
   
   
   Dim objFSO As Object
   
   'Create the file system object
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   
   strPath = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
'      strPath = ActiveWorkbook.Path & "\"  'this is my version
      
   'initialize index counter
   iIndex = 0
      
   'loop through filenames
                                    'for now, just one array element. future: add code to loop
      ReDim Preserve arrPath(iIndex)
      ReDim Preserve arrFile1(iIndex)
      ReDim Preserve arrFile2(iIndex)

      'load array of filenames
      arrPath(iIndex) = strPath
      arrFile1(iIndex) = "File1.xlsx"
      arrFile2(iIndex) = "File2.xlsx"
      
      Call IndexMatch(strPath, arrPath(iIndex) _
         , arrFile1(iIndex), arrFile2(iIndex) _
         , "F1:F", "B1:B", "C1:C", "A1:A")

      'increment counter
      iIndex = iIndex + 1
      
   'end loop
   
   iIndex = iIndex - 1  'correct number for last array item with value
   
'~~~~~~~~~~~~~~~~~~~~~~
Proc_Exit:
   On Error Resume Next
   'release object variables
   Set objFSO = Nothing
   Exit Sub
 
Proc_Err:
   MsgBox Err.Description, , _
     "ERROR " & Err.Number _
     & "   callingcode"
 
   Resume Proc_Exit
End Sub

'-----------------------------------------------------------------------------

Sub IndexMatch( _
   ByVal strPathobjWB1 As String _
   , ByVal strPathobjWB2 As String _
   , ByVal strWB1Name As String _
   , ByVal strWB2Name As String _
   , ByVal strDesintationRange As String _
   , ByVal strIndexRange As String _
   , ByVal strMatchRange As String _
   , ByVal strComparedRange As String)
'151122 strive4peace modified NOT DONE

   'set up Error Handler
   On Error GoTo Proc_Err
   
   ' File I/O constants
   Dim objExcel As Object _
      , objWB1  As Object _
      , objWB2 As Object _
      , objWS1 As Object _
      , objWS2  As Object
   
   Dim nRowLast1 As Long _
      , nRowLast2 As Long
      
   '=====================================

'these aren't needed -- used ByVal to pass parameters for new copy for just the procedure
'      , strWB1Name As Object _
'      , strWB2Name As Object _   'this can be deleted

   '=====================================
   ' Variables are :
   
   ' strPathobjWB1 = Path of your File1 which have the Target Range
   ' strPathobjWB2 = Path of your File2 which will receive the IndexMatch formula
   ' strWB1Name = Workbook1 Name (Target)
   ' strWB2Name  = Workbook2 Name

   ' strDestinationRange is the Range which will receive the Formula located in strWB2Name
   ' strIndexRange is the Range that you want to bring located in strWB1Name
   ' strMatchRange is your Key Range located in the same Workbook that strDestinationRange located in strWB2Name
   ' strComparedRange is the Range to compared with your strMatchRange
   '     located in the same workbook that your strIndexRange located in strWB1Name (WB1)
   '=====================================

   ' Excel application definition
   Set objExcel = CreateObject("Excel.Application")
   
   objExcel.Visible = True
   
   ' Set your Workbooks name
'   strWB1Name = strWB1Name
'   strWB2Name = strWB2Name
   
   ' Open File 1 and File 2
   
   Set objWB1 = objExcel.Workbooks.Open(strPathobjWB1 & strWB1Name)
   Set objWS1 = objWB1.Sheets(1)
   With objWS1
'      nRowLast1 = .UsedRange.Rows.Count
      nRowLast1 = .Cells(.Rows.Count, 1).End(-4162).Row 'xlUp=-4162
   End With
   
   Set objWB2 = objExcel.Workbooks.Open(strPathobjWB2 & strWB2Name)
   Set objWS2 = objWB2.Sheets(1)
   '----------------------------------- use target sheet
   With objWS2
'      nRowLast2 = .UsedRange.Rows.Count
      nRowLast2 = .Cells(.Rows.Count, 1).End(-4162).Row 'xlUp=-4162

      ' Perform Index Match formula
   
      .Range(strDesintationRange & nRowLast2) = _
         objExcel.WorksheetFunction.Index( _
            objWS1.Range _
               (strIndexRange & nRowLast1), _
         objExcel.WorksheetFunction.Match( _
            .Range(strMatchRange & nRowLast2) _
               , objWS1.Range _
               (strComparedRange & nRowLast1), 0))
   End With

   ' Save File 2, Close
  
   objWB2.Save
   'False since we just saved and don't need to save again
   objWB2.Close False
   Set objWB2 = Nothing
   
   ' close File 1
   objWB1.Close False
   Set objWB1 = Nothing
   
   objExcel.Quit 'instead of quitting, this should be passed as an ibject from callingcode
   Set objExcel = Nothing
   
'~~~~~~~~~~~~~~~~~~~~~~
Proc_Exit:
   On Error Resume Next
   'release object variables
    If Not objWS2 Is Nothing Then
      Set objWS2 = Nothing
   End If
   If Not objWS1 Is Nothing Then
      Set objWS1 = Nothing
   End If
   If Not objWB2 Is Nothing Then
      objWB2.Close
      Set objWB2 = Nothing
   End If
   If Not objWB1 Is Nothing Then
      objWB1.Close
      Set objWB1 = Nothing
   End If
   If Not objExcel Is Nothing Then
      objExcel.Quit 'instead of quitting, this should be passed as an ibject from callingcode
      Set objExcel = Nothing
   End If
   Exit Sub
 
Proc_Err:
   MsgBox Err.Description, , _
     "ERROR " & Err.Number _
     & "   IndexMatch"
 
   Resume Proc_Exit
End Sub

Open in new window


... am getting ready to test it now ... just thought you might like to know that I'm looking at it ~
0
crystal (strive4peace) - Microsoft MVP, AccessRemote Training and ProgrammingCommented:
got it.

callingcode needs to send absolute references
      Call IndexMatch(strPath, arrPath(iIndex) _
         , arrFile1(iIndex), arrFile2(iIndex) _
         , "$F$1:$F$", "$B$1:$B$", "$C$1:$C$", "$A$1:$A$")

Open in new window

here is updated IndexMatch procedure
Sub IndexMatch( _
   ByVal strPathobjWB1 As String _
   , ByVal strPathobjWB2 As String _
   , ByVal strWB1Name As String _
   , ByVal strWB2Name As String _
   , ByVal strDesintationRange As String _
   , ByVal strIndexRange As String _
   , ByVal strMatchRange As String _
   , ByVal strComparedRange As String)
'151122 strive4peace modified NOT DONE

   'set up Error Handler
   On Error GoTo Proc_Err
   
   ' File I/O constants
   Dim objExcel As Object _
      , objWB1  As Object _
      , objWB2 As Object _
      , objWS1 As Object _
      , objWS2  As Object
   
   Dim nRowLast1 As Long _
      , nRowLast2 As Long _
      , sSheetname1 As String _
      , sSheetname2 As String
      
   '=====================================
   ' PARAMETERS
   
   ' strPathobjWB1 = Path of your File1 which have the Target Range
   ' strPathobjWB2 = Path of your File2 which will receive the IndexMatch formula
   ' strWB1Name = Workbook1 Name (Target)
   ' strWB2Name  = Workbook2 Name

   ' F - 2 strDestinationRange is the Range which will receive the Formula located in strWB2Name
   ' B - 1 strIndexRange is the Range that you want to bring located in strWB1Name
   ' C - 2 strMatchRange is your Key Range located in the same Workbook that strDestinationRange located in strWB2Name
   ' A - 1 strComparedRange is the Range to compared with your strMatchRange
   '                        located in the same workbook that your strIndexRange located in strWB1Name (WB1)
   '=====================================

   ' Excel application definition
   Set objExcel = CreateObject("Excel.Application")
   
   objExcel.Visible = True
   
   ' Open File 1 and File 2
   
   Set objWB1 = objExcel.Workbooks.Open(strPathobjWB1 & strWB1Name)
   Set objWS1 = objWB1.Sheets(1)
   With objWS1
'      nRowLast1 = .UsedRange.Rows.Count
      nRowLast1 = .Cells(.Rows.Count, 1).End(-4162).Row  'xlUp=-4162
      sSheetname1 = .Name
   End With
     
   Set objWB2 = objExcel.Workbooks.Open(strPathobjWB2 & strWB2Name)
   Set objWS2 = objWB2.Sheets(1)
   '----------------------------------- use target sheet
   With objWS2
'      nRowLast2 = .UsedRange.Rows.Count
      nRowLast2 = .Cells(.Rows.Count, 1).End(-4162).Row  'xlUp=-4162
      sSheetname2 = .Name

      ' Perform Index Match formula -- change .Formula property
      .Range(strDesintationRange & nRowLast2).Formula = _
         "= INDEX('[" & strWB1Name & "]" & sSheetname1 & "'!" _
            & strIndexRange & nRowLast1 & "," _
         & " Match( " _
         & strMatchRange & nRowLast2 & ",'[" _
              & strWB1Name & "]" & sSheetname1 & "'!" _
              & strComparedRange & nRowLast1 & ",0), 0)"
      'code could be added to calculate and store the value instead of storing formula
      
   End With

   ' Save File 2, Close
  
   objWB2.Save
   'False since we just saved and don't need to save again
   objWB2.Close False
   Set objWB2 = Nothing
   
   ' close File 1
   objWB1.Close False
   Set objWB1 = Nothing
   
   objExcel.Quit 'instead of quitting, this should be passed as an ibject from callingcode
   Set objExcel = Nothing
   
'~~~~~~~~~~~~~~~~~~~~~~
Proc_Exit:
   On Error Resume Next
   'release object variables
    If Not objWS2 Is Nothing Then
      Set objWS2 = Nothing
   End If
   If Not objWS1 Is Nothing Then
      Set objWS1 = Nothing
   End If
   If Not objWB2 Is Nothing Then
      objWB2.Close
      Set objWB2 = Nothing
   End If
   If Not objWB1 Is Nothing Then
      objWB1.Close
      Set objWB1 = Nothing
   End If
   If Not objExcel Is Nothing Then
      objExcel.Quit 'instead of quitting, this should be passed as an ibject from callingcode
      Set objExcel = Nothing
   End If
   Exit Sub
 
Proc_Err:
   MsgBox Err.Description, , _
     "ERROR " & Err.Number _
     & "   IndexMatch"
 
   Resume Proc_Exit
   Resume
End Sub

Open in new window

0
LD16Author Commented:
Thank you very much. I will test it as soon as I can.
0
crystal (strive4peace) - Microsoft MVP, AccessRemote Training and ProgrammingCommented:
you're welcome ~ making an assumption there will be a loop in callingcode.  Rather than creating and releasing the Excel object over and over, it would be a good idea, if you are going to loop, to create objExcel in callingcode.  It could then be passed as a parameter to IndexMatch. Personally, I like to send objects first in the order.
0
LD16Author Commented:
Hello,

I tested your script and I have error messages concerning the variables declarations.

The unique ways that I was able to run your script is to set up like this:


' File I/O constants
Const ForAppending = 8

'Create the file system object
Set objFSO = CreateObject("Scripting.FileSystemObject")

strPath = Replace(WScript.ScriptFullName, WScript.ScriptName, "")

Call IndexMatch(strPath, strPath _
         , "File1.xlsx", "File2.xlsx" _
         , "$F$1:$F$", "$B$1:$B$", "$C$1:$C$", "$A$1:$A$")

Sub IndexMatch(strPathobjWB1,strPathobjWB2,strWB1Name,strWB2Name, _
strDesintationRange,strIndexRange,strMatchRange, _
strComparedRange)

  'set up Error Handler
   'On Error GoTo Proc_Err

   
   ' File I/O constants
   Dim objExcel 
   Dim nRowLast1,nRowLast2,sSheetname1
      
   '=====================================
   ' PARAMETERS
   
   ' strPathobjWB1 = Path of your File1 which have the Target Range
   ' strPathobjWB2 = Path of your File2 which will receive the IndexMatch formula
   ' strWB1Name = Workbook1 Name (Target)
   ' strWB2Name  = Workbook2 Name

   ' F - 2 strDestinationRange is the Range which will receive the Formula located in strWB2Name
   ' B - 1 strIndexRange is the Range that you want to bring located in strWB1Name
   ' C - 2 strMatchRange is your Key Range located in the same Workbook that strDestinationRange located in strWB2Name
   ' A - 1 strComparedRange is the Range to compared with your strMatchRange
   '                        located in the same workbook that your strIndexRange located in strWB1Name (WB1)
   '=====================================

   ' Excel application definition
   Set objExcel = CreateObject("Excel.Application")
   
   objExcel.Visible = True
   
   ' Open File 1 and File 2
   
   Set objWB1 = objExcel.Workbooks.Open(strPathobjWB1 & strWB1Name)
   Set objWS1 = objWB1.Sheets(1)
   With objWS1
'      nRowLast1 = .UsedRange.Rows.Count
      nRowLast1 = .Cells(.Rows.Count, 1).End(-4162).Row  'xlUp=-4162
      sSheetname1 = .Name
   End With
     
   Set objWB2 = objExcel.Workbooks.Open(strPathobjWB2 & strWB2Name)
   Set objWS2 = objWB2.Sheets(1)
   '----------------------------------- use target sheet
   With objWS2
'      nRowLast2 = .UsedRange.Rows.Count
      nRowLast2 = .Cells(.Rows.Count, 1).End(-4162).Row  'xlUp=-4162
      sSheetname2 = .Name

      ' Perform Index Match formula -- change .Formula property
      .Range(strDesintationRange & nRowLast2).Formula = _
         "= INDEX('[" & strWB1Name & "]" & sSheetname1 & "'!" _
            & strIndexRange & nRowLast1 & "," _
         & " Match( " _
         & strMatchRange & nRowLast2 & ",'[" _
              & strWB1Name & "]" & sSheetname1 & "'!" _
              & strComparedRange & nRowLast1 & ",0), 0)"
      'code could be added to calculate and store the value instead of storing formula
      
   End With

   ' Save File 2, Close
  
   objWB2.Save
   'False since we just saved and don't need to save again
   objWB2.Close False
   Set objWB2 = Nothing
   
   ' close File 1
   objWB1.Close False
   Set objWB1 = Nothing
   
   objExcel.Quit 'instead of quitting, this should be passed as an ibject from callingcode
   Set objExcel = Nothing
   
'~~~~~~~~~~~~~~~~~~~~~~
   On Error Resume Next
   'release object variables
    If Not objWS2 Is Nothing Then
      Set objWS2 = Nothing
   End If
   If Not objWS1 Is Nothing Then
      Set objWS1 = Nothing
   End If
   If Not objWB2 Is Nothing Then
      objWB2.Close
      Set objWB2 = Nothing
   End If
   If Not objWB1 Is Nothing Then
      objWB1.Close
      Set objWB1 = Nothing
   End If
   If Not objExcel Is Nothing Then
      objExcel.Quit 'instead of quitting, this should be passed as an ibject from callingcode
      Set objExcel = Nothing
   End If
   Exit Sub
 '~~~~~~~~~~~~~~~~~~~~~~
Proc_Exit:
   On Error Resume Next
   'release object variables
    If Not objWS2 Is Nothing Then
      Set objWS2 = Nothing
   End If
   If Not objWS1 Is Nothing Then
      Set objWS1 = Nothing
   End If
   If Not objWB2 Is Nothing Then
      objWB2.Close
      Set objWB2 = Nothing
   End If
   If Not objWB1 Is Nothing Then
      objWB1.Close
      Set objWB1 = Nothing
   End If
   If Not objExcel Is Nothing Then
      objExcel.Quit 'instead of quitting, this should be passed as an ibject from callingcode
      Set objExcel = Nothing
   End If
   Exit Sub
 
'Proc_Err:
   'MsgBox Err.Description, , _
     '"ERROR " & Err.Number _
     '& "   IndexMatch"
 
   'Resume Proc_Exit
   'Resume
End Sub

Open in new window



I have some questions:

1-Why are you using .Formula property and not Worksheet.Function I tested both and in term of performance I got the same result?
2-With your code I am still having #NA values how should proceed to clean those value?
3-I have a problem with this set up:
  nRowLast1 = .Cells(.Rows.Count, 1).End(-4162).Row
In fact, if I add just a new value in Column C and not in Column A I don't get the returned formula.
In order to have a returned formula I should field values in Column C and at least a value in Column A even if Column A is not defined as a parameter in the IndexMatch formula.
4-It will be great if we can add a loop to open recent Files based on a prefix name as File1 and File2 don't have a fix name example they will be dynamically generated on a daily basis with the following format ie : File1_MMHHDDYYY File2_MMHHDDYYY
I was thinking  to include the following procedure in order to open recent files with prefix (obviously it can be optimize, log activities and final if condition if the file reported with the prefix and extension don't match with the parameter reported).


' Define path to work it

strPath = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
TargetPath =  strPath & "\Input\"

Call OpenRecentFile (TargetPath,"File1",5,".xls",4)

' ===============================================
' Parameters are: 
' TargetPath in which is your file to open
' prefix name of your file
' Number of letter of your prefix
' Extension of your file
' Number of letter of your extension
' ===============================================

Sub OpenRecentFile(strinputfolder,strFileString,strFileStringN,strFileStringExt,strFileStringExtN)


Set objExcel = CreateObject("Excel.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
objExcel.Visible = True
objExcel.DisplayAlerts=False


	iniNewestFile = False
	
	For Each objFile In objFSO.GetFolder(strinputfolder).Files
		If LCase(Right(objFile.Name, strFileStringExtN)) = strFileStringExt And Left(LCase(objFile.Name), strFileStringN) = strFileString Then
			If objNewestFile = "" Then   
	  			Set objNewestFile = objFile 
	  			iniNewestFile = True 
	  	  	Else   
		  		If objNewestFile.DateLastModified < objFile.DateLastModified Then    
		  			Set objNewestFile = objFile
		  			iniNewestFile = True   
		  		End If  
	  		End If
		End If
	
	Next
	
	If iniNewestFile Then
		Set objWB = objExcel.Workbooks.Open(objNewestFile.Path)
		Set objWs = objWb.Sheets(1)
 	End If
		
End Sub

Open in new window


Thank you very much for your help.
0
crystal (strive4peace) - Microsoft MVP, AccessRemote Training and ProgrammingCommented:
you're welcome

>  nRowLast1 = .Cells(.Rows.Count, 1).End(-4162).Row
In fact, if I add just a new value in Column C and not in Column A I don't get the returned formula.
In order to have a returned formula I should field values in Column C and at least a value in Column A :

then use .Cells(.Rows.Count, 3)

> 4-It will be great if we can add a loop to open recent Files based on a prefix name as File1 and File2 don't have a fix name example they will be dynamically generated on a daily basis with the following format ie : File1_MMHHDDYYY File2_MMHHDDYYY

here is generic code to load files into an array.  You would want to change sPath to look for your pattern.  I would loop and first load files called "File1_*.xlsx" and then make another loop to look at MMHHDDYYY in each file 1 and get the corresponding File2.
Sub LoadFilesArray()
   Dim sPath As String _
      , iFileNum As Integer
      
   sPath = ActiveWorkbook.Path & "\"  '------------------------- customize
   
   Dim arrFile() As String
   
   iFileNum = 0
   ReDim arrFile(0)
   arrFile(0) = Dir(sPath)
   
   Do While arrFile(iFileNum) <> ""
      If (GetAttr(sPath & "\" & arrFile(iFileNum)) _
       And vbDirectory) <> vbDirectory Then
         iFileNum = iFileNum + 1
         ReDim Preserve arrFile(iFileNum)
         arrFile(iFileNum) = Dir()
      End If
   Loop
   
   'remove last entry which is blank
   If iFileNum > 1 Then ReDim Preserve arrFile(iFileNum - 1)
   
   For iFileNum = LBound(arrFile) To UBound(arrFile)
      Debug.Print arrFile(iFileNum)
   Next iFileNum
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
LD16Author Commented:
Thank you again for your great support and help.
0
crystal (strive4peace) - Microsoft MVP, AccessRemote Training and ProgrammingCommented:
you're welcome ~ happy to help
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.