Start Free Trial

asked on

VBA: Index match and re-inserting lines with multiple target values.

Hello Expert,

I use the following code to index match values from different sheets

Dim p As Integer, q As Integer

With ActiveSheet.Select

Range("F2", Range("F" & Rows.Count).End(xlUp)).Clear

Set Target = Range("sheet1!B2:C" & Rows.Count)
Set matchvalue = Range("C2", Range("C" & Rows.Count).End(xlUp))
Set comparedvalue = Range("sheet1!A2:A" & Rows.Count)

For Each c In matchvalue

If IsNumeric(Application.Match(c, comparedvalue, 0)) Then
c.Offset(, 1).Value = Application.WorksheetFunction.Index(Target, Application.WorksheetFunction.Match(c, comparedvalue, 0), 0)
End If
Next c
End With

Open in new window

However I would like to enhance this code to manage different Target values with different compared values

Ex:

Sheet1:

aaa,111
bbb,222
ccc,333
aaa,3455
ddd,444
aaa,456789

(aaa, contains more than one target value)

ActiveSheet

C1,C2,aaa,C3,C4
C1,C2,ddd,C3,C4
C3,C4,aaa,C3,C4
C1,C2,ccc,C3,C4
C1,C2,bbb,C3,C4
C1,C2,aaa,C3,C4
C1,C2,bbb,C3,C4
C1,C2,aaa,C3,C4
C1,C2,aaa,C3,C4
C1,C2,ccc,C3,C4

After I run the script some lines need to be re-inserting to display all the Target values with the same compared value
ActiveSheet
C1,C2,aaa,C3,C4,111
C1,C2,aaa,C3,C4,3455
C1,C2,aaa,C3,C4,456789
C1,C2,ddd,C3,C4,444
C3,C4,aaa,C3,C4,111
C3,C4,aaa,C4,3455
C3,C4,aaa,C4,456789
C1,C2,ccc,C3,C4,333
....

Could someone provide the VB Script or the VBA solution?
Thank you in advance for your help.

ASKER

@Aikimark:

One question is related to VBA in which I provide my code to be enhanced.
The other question is related to VB Script in which I take as a reference another VB Script Code.
The two questions cannot be merged as they are related to different Programming languages and they use differents input codes.

Please don't delete the questions.

Thank you in advance.

ASKER

If necessary I can change data example. The problem is similar however the solution of each problem will be completely different. One will be coded in Vba and the orher in VB script. If necessary I can merge the question into one requesting the VBA and Vbscript approach.

ASKER

Ok, If the best is to remove the other question, I remove the question.

ASKER

Technically they are the same but I expect two approaches. VB Script approach and VBA Approach.

ASKER

You can run in VB Script VBA with Excel Application however if I want to launch the script from a server with task scheduler it will not works if I don't have an opened windows session, I have already test it.

I want to have the two solutions as it can be useful for my general knowledge.

Regards,

ASKER

I can with VB Script I cannot when I use VB Script with Excel.Application as it's required to have a office session available. You cannot open a Excel sheet if you don't have a session available this is why I want to have the pure VB Script approach without using Excel.Application and also the VBA approach.

What is your budget?
What are you allowed to install on the server?
Which Excel workbook formats will you be required to process?

It would probably be cheaper and simpler to install Excel on the server than to try to solve this with a third party or .Net solution.

ASKER

I think there is a misunderstanding, I have excel in my server the thing is when I launch an Excel.Application script through task scheduler I need to be connected in the server whereas if I launch a pure .vbs through task scheduler I can do it without having a windows session opened.
By the way could you please help me with the solution in VBA or in VB Script?
Thank you in advance for your help.

What privileges are you running with when the scheduled task fails?
What does your scheduled task look like when it fails?

I think you have finally revealed your actual problem/question in your latest comment.

ASKER

Administrator highest privileges.

Please find attached the mentioned options.

User generated image

It is not possible to run a VB Script which call a Excel.Application using the option "Run whether user is logged on or not". The unique way to run it is to select the option "Run only when user is logged on".

However for a pure VB Script which doesn't call Excel Application I can select the second option which allows me to be logged off of the server.

what command are you executing in this task?

ASKER

Simple command :

Option Explicit

Dim xlApp, xlBook

Set xlApp = CreateObject("Excel.Application")
'~~> Change Path here
Set xlBook = xlApp.Workbooks.Open("C:\Users\1\Import_cleaning_1.4.1.xlsm", 0, True)
xlApp.Run "run_csv_import"
xlBook.Close
xlApp.Quit

Open in new window

Can we focus on the first question I will create another question concerning the schedule task run if necessary.

I meant HOW are you launching the process in the scheduled task?

ASKER

I just click on run, by the way it is a "schedule task" so it's run itself

Please bring up the properties dialog for that scheduled task and post the executable line and the working directory text.

ASKER

Hello, the scheduled task is another problem I would like to have advices concerning my question: ID: 28655245

ASKER

I don't understand your comment.

Firstrly you ask me to merge VB Script and VBA questions as they were the same. I followed your recommendation and I delete VB Script to keep VBA question.

Now that I want is to have a proposal concerning my question 2865524.

Now that I want is to have a proposal concerning my question 2865524.

http:Q_28655245.html is this question

I've asked you a question that you have not answered. I'm actually trying to help you with your problem. You must participate.

ASKER

Ok. I have solved the schedule task problem. I gave me full admin access in the server.

Concerning question 228655245 I have not received a proposal.

did the rights change solve your problem?

ASKER

Yes for the schedule task.

ASKER

The problem related to the schedule task is solved, however I want expertise and an proposal related to question 28655245

What is the worksheet name that needs to be updated?

ASKER

ActiveSheet = sheet 2

This code should be used in conjunction with your existing script. You will need to add qualifiers to your open workbook and replace "Application" with the name of your Excel automation object variable.

    Dim dicKeys ' As Object
    Dim rng ' As Range
    Dim wks ' As Worksheet
    Dim vParsed ' As Variant
    Dim lngRow ' As Long
    Dim lngEnd ' As Long
    Dim lngNextValue ' As Long
    Dim vItem ' As Variant
    Dim strValue ' As String
    
    Set dicKeys = CreateObject("scripting.dictionary")
    Set wks = Worksheets("Sheet1")
    For Each rng In wks.Range(wks.Range("A1"), wks.Range("A1").End(xlDown))
        vParsed = Split(rng.Value, ",")
        If dicKeys.exists(vParsed(0)) Then
            dicKeys(vParsed(0)) = dicKeys(vParsed(0)) & "^" & vParsed(1)
        Else
            dicKeys(vParsed(0)) = vParsed(1)
        End If
    Next
    
    Set wks = Worksheets("Sheet2")
    lngEnd = wks.Range("A1").End(xlDown).Row
    Application.ScreenUpdating = False  'use Excel object here
    For lngRow = lngEnd To 1 Step -1
        vParsed = Split(wks.Cells(lngRow, 1).Value, ",")
        If dicKeys.exists(vParsed(2)) Then
            strValue = wks.Cells(lngRow, 1).Value
            wks.Rows(lngRow).Delete
            wks.Rows(lngRow).Resize(UBound(Split(dicKeys(vParsed(2)), "^")) + 1).Insert
            lngNextValue = lngRow
            For Each vItem In Split(dicKeys(vParsed(2)), "^")
                wks.Cells(lngNextValue, 1).Value = strValue & "," & vItem
                lngNextValue = lngNextValue + 1
            Next
        End If
    Next
    Application.ScreenUpdating = True   'use Excel object here

Open in new window

ASKER

Hello aikimark,

Thank you for your code, I have some questions:

1-How should I run this code Can I run it directly through an Excel File by inserting it into a VBA Module or through an independent .vbs file?
2-If the first I need to enter a Sub and a End sub between your code?
3-When you say in "conjunction with my existing script" you refer to the code which is in the question ID: 28655245. I suppose that yes but I want to confirm.
4-I don't understand: "You will need to add qualifiers to your open workbook and replace "Application" with the name of your Excel automation object variable". It would be great if you can help me to add it this because I don't know how to do it.

Once again, thank you for your help!

You should be able to run this in either environment.
I tested this code in an Excel VBA environment, so it was the body of a sub routine in a workbook module.
The code does not open a workbook. You already have VBScript code that does that.

ASKER

Ok, thank you for your feedback, should I need to add something else to your code or can I directly test it like this?

If you have a workbook with the data in Sheet1 and Sheet2, you should be able to create a new routine, paste the code into the routine, and run the routine in its current state.

To run this as a VBScript, you will need to add the VBS code from your previous question and qualify some of the assignments (Set wks =) with your workbook variable. Also, the "Application" object will need to be changed to your Excel automation object variable.

ASKER

Perfect I test it and It works, however this suit for csv files when you have all the data compiled in one column.

However I just realized that the data of Sheet 1 and Sheet 2 is already is already splitted in multiple column:

The key in sheet 1will be placed in column C and the key in Sheet 2 is also in column C.

Additionnally it would be great if all the modifications are done in a Sheet 3 this will help me see the difference between the initial Sheet 2 and the revised version in Sheet 3 after I launch the script.

Thank you again for your help.

That's what happens when you don't post a representative sample of the data. Please post a workbook or CSV with the data as it will be encountered by the code.

ASKER

Sorry for this.
Please find attached sample file.
Key of Sheet1 Column A
Key of Sheet2 Column C

Regards,
index-match-multiple-insert.xlsm

SOLUTION

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

ASKER

Perfect I will test it tomorrow.

ASKER

Ok, I have test it and it works! Thank you again now the challenge is to convert this code into pure VB Script.

Here is the code provided in the solution:

https://www.experts-exchange.com/questions/26685812/VLookUP-by-vbscript.html?anchorAnswerId=34385354#a34385354:

' Define constants
Const cForReading = 1
Const cForWriting = 2
Const cForAppending = 8
Const cTristateTrue = -1
Const cTristateFalse = 0
Const cTristateUseDefault = -2

' Define filenames
Const cInFile1 = "C:\Temp\EE26685812\file1.csv"
Const cInFile2 = "C:\Temp\EE26685812\file2.csv"
Const cOutFile = "C:\Temp\EE26685812\file3.csv"

' Set up objects needed
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oDict = CreateObject("Scripting.Dictionary")
 
' Load dictionary entries from text file of replacements
Set oInFile1 = oFSO.OpenTextFile(cInFile1, cForReading)
Do Until oInFile1.AtEndOfStream
   aLine = Split(oInFile1.Readline, ",")
   If Not oDict.Exists(aLine(0)) Then
      oDict.Add aLine(0), aLine(1)
   End If
Loop
oInFile1.Close
 
' Read input file, lookup replacement, write new output line'
Set oInFile2 = oFSO.OpenTextFile(cInFile2, cForReading)
Set oOutFile = oFSO.OpenTextFile(cOutFile, cForWriting, True)
Do Until oInFile2.AtEndOfStream
   aLine = Split(oInFile2.Readline, ",")
   ReDim Preserve aLine(UBound(aLine)+1)
   aLine(5) = aLine(4)
   aLine(4) = aLine(3)
   If oDict.Exists(aLine(2)) Then
      aLine(3) = oDict.Item(aLine(2))
   Else
      aLine(3) = "N/A"
   End If
   oOutFile.WriteLine Join(aLine, ",")
Loop

' Done
oInFile2.Close
oOutFile.Close

Open in new window

I am not sure how can I adapt your code using pure VB Script variables based on this code. Thank you again for your help!

@LD16,

This VBS should do what I think you are looking for, adjust and test.

' Define constants
Const cForReading = 1
Const cForWriting = 2
Const cForAppending = 8
Const cTristateTrue = -1
Const cTristateFalse = 0
Const cTristateUseDefault = -2

' Define filenames
Const cInFile1 = "B:\EE\EE28655245\file1.csv"
Const cInFile2 = "B:\EE\EE28655245\file2.csv"
Const cOutFile = "B:\EE\EE28655245\file3.csv"

' Set up objects needed
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oDict = CreateObject("Scripting.Dictionary")
 
' Load dictionary entries from text file of replacements
Set oInFile1 = oFSO.OpenTextFile(cInFile1, cForReading)
Do Until oInFile1.AtEndOfStream
   aLine = Split(oInFile1.Readline, ",")
   If oDict.Exists(aLine(0)) Then
      oDict.Item(aLine(0)) = oDict.Item(aLine(0)) & "," & aLine(1)
   Else
      oDict.Add aLine(0), aLine(1)
   End If
Loop
oInFile1.Close
 
' Read input file, lookup replacement, write new output line'
Set oInFile2 = oFSO.OpenTextFile(cInFile2, cForReading)
Set oOutFile = oFSO.OpenTextFile(cOutFile, cForWriting, True)
Do Until oInFile2.AtEndOfStream
   aLine = Split(oInFile2.Readline, ",")
   ReDim Preserve aLine(UBound(aLine)+1)
   aLine(5) = aLine(4)
   aLine(4) = aLine(3)
   If oDict.Exists(aLine(2)) Then
      aValues = Split(oDict.Item(aLine(2)), ",")
      For Each sValue In aValues
         aLine(3) = sValue
         oOutFile.WriteLine Join(aLine, ",")
      Next
   Else
      aLine(3) = "N/A"
      oOutFile.WriteLine Join(aLine, ",")
   End If
Loop

' Done
oInFile2.Close
oOutFile.Close

Open in new window

~bp

ASKER

Hello Bill,

Thank you for your help. I have test it and it works!

I have just few remarks:

1- how can I properly add combine headers from file 1 and file 2

I Know that I can try something like this

oOutFile.WriteLine "Field1" & ";" & "Field2"

However I would like use existing variable from the various files.

2-I was wondering how can I create a simple loop to wscript.quit when the file is s not available for writting as it is already opened by another user?

Thank you in advance for your help!

So, do both file1 and file2 have a single first line as a header line? And you want to merge those values to create a new header line to be written at the top of the output file?

When the output file is in use, you just want to exit? You mentioned "loop" in there, but wasn't sure if that's what you meant.

~bp

ASKER

I think it will clearer if I give you an example:

File 1 contains the following header:

CP;Code (Code is the header of the values which appear in file3)

File 2 contains the following header:

CC; Designation; FHM;CP

Header of Output file should contains:

CC; Designation; FHM;CP;Code

So CC, Designation, FHM are the headers of File 2 and Code header of File 1.

Sorry I made a mistake concerning the loop, I need an

if objfile ..... then
wscript.quit
objLogFile.WriteLine "ERROR - File cannot be modified"

ASKER CERTIFIED SOLUTION

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

ASKER

I test it and it works, excellent as always! thank you again Bill!
I didn't now about this ShowError sub. I am sure that I will re-use it!

Welcome, glad that was useful.

~bp