Home » Handling pairs of pattern matching in multiple excel files through VB macros

Handling pairs of pattern matching in multiple excel files through VB macros

Solutons:


my assumptions:

Excel_In1.xls == catalog.xlsx (table has unique key pair columnA & columnB in each row)

Excel_In2.xls == factdata.xlsx (table has multiple duplicate key pairs; and contains data in fixed columns to be copied)

Excel_Out.xls == book Out.xlsm

Option Explicit

Private Type TState
    catalog As Object
    selectedData As Object
End Type

Private this As TState

Public Sub ExampleSubMain()
    Init
    PickData
    ExecuteCopying
End Sub

Private Sub Init()
    InitCatalogDictionary
    Set this.selectedData = CreateObject("Scripting.Dictionary")
End Sub

Private Sub InitCatalogDictionary()
    MakeTheBookOpened "D:vbasomefolder", "catalog.xlsx"
    
    Dim wb As Workbook
    Set wb = Workbooks("catalog.xlsx")
    
    Dim dataRange As Range
    Set dataRange = wb.Worksheets("catalogSheet").Range("a2:b10") 'for example "a2:b10"

    Set this.catalog = MakeDict(dataRange)
End Sub

Private Function MakeDict(ByVal dataRange As Range) As Object
    
    Dim result As Object
    Set result = CreateObject("Scripting.Dictionary")
    
    Dim row As Range
    For Each row In dataRange.Rows
        'asumes column A,B are true keys and their pairs are unique, value = empty string
        result.Add Join(Array(row.Cells(1), row.Cells(2))), ""
    Next row
    
    Set MakeDict = result
End Function

Private Sub MakeTheBookOpened(ByVal pathWithSeparator As String, _
                              ByVal wbName As String)
    If TheBookIsOpenedAlready(wbName) Then Exit Sub
    Workbooks.Open Filename:=pathWithSeparator & wbName, ReadOnly:=True
End Sub

Private Function TheBookIsOpenedAlready(ByVal Name As String) As Boolean
    Dim wb As Workbook
    For Each wb In Workbooks
        If wb.Name = Name Then TheBookIsOpenedAlready = True: Exit Function
    Next wb
End Function

Private Sub PickData()
    MakeTheBookOpened "D:vbasomefolder", "factdata.xlsx"
    
    Dim wb As Workbook
    Set wb = Workbooks("factdata.xlsx")
    
    Dim dataRange As Range
    Set dataRange = wb.Worksheets("factSheet").Range("a2:k10") 'for example "a2:k10"
    
    Dim row As Range
    For Each row In dataRange.Rows
        Dim key As String
        key = Join(Array(row.Cells(4), row.Cells(6))) 'asumes product123, companyABC columns are there
        If this.catalog.Exists(key) Then this.selectedData.Add row, ""
    Next row
End Sub

Private Sub ExecuteCopying()
    If this.selectedData.Count = 0 Then Exit Sub
    
    Dim rowsNum As Long
    rowsNum = this.selectedData.Count
    
    Dim columnsNum As Long
    columnsNum = 3                               'for example 3
    
    Dim resultArr As Variant
    ReDim resultArr(1 To rowsNum, 1 To columnsNum)
    
    Dim pos As Long
    pos = 1
    
    Dim item As Variant
    For Each item In this.selectedData
        Dim row As Range
        Set row = item
        resultArr(pos, 1) = row.Cells(2)         'B
        resultArr(pos, 2) = row.Cells(7)         'G
        resultArr(pos, 3) = row.Cells(10)        'J
        pos = pos + 1
    Next item
    
    'book Out.xlsm
    ThisWorkbook.Worksheets(1).Range("a1").Resize(rowsNum, columnsNum) = resultArr
End Sub

Given two basic input files roughly matching your description:

enter image description here

and

enter image description here

And assuming the macro would reside in the out file, we could construct a multi-function macro to accomplish this with a few steps.

The first part of the macro knows filenames and parameters. You used column L in the first input file, but let’s make that configurable. The same with most of the other parameters, like the first line to start on so our input files can have headers.

Second, we need to open the first input file and read the keywords. There’s several ways to do this, but a very simple way to do it is to do a plan CSV line, so that from the first file, you can extract your “keywords” (your term): product123,product456. This can then be iterated over with a For Each loop through the second file.

In the second file, a very simple construct would be to loop over all entries. Depending on your needs, you may need to iterate through the second file only once if it is prohibitively large. Both of these function assume the first blank line terminates the input. If the row in the 2nd input file matches your target, you will perform your copy.

Finally, the copy also takes a CSV line for which columns to keep (keeping it configurable). Each column, as well as the first keyword, will be copied to the target worksheet, starting at row 1 with a configurable column start.

The final output in the output sheet looks something like this:

enter image description here

The output starts in the second column because that was what was specified in the configuration.

There may be more elegant approaches, but this is a straight-forward approach to it.

Const EXCEL_1 As String = "Excel1.xls"
Const EXCEL_1_KW_COL As String = "A"
Const EXCEL_2 As String = "Excel2.xls"
Const EXCEL_2_KW_COL As String = "A"
Const EXCEL_2_COPY_COLS As String = "B,E,G"
Const EXCEL_3 As String = "Excel3.xls"
Const EXCEL_3_TARGET As String = "B"

Public Function LoadInformation3()
  Dim Location As String, Keywords As String
  Application.ScreenUpdating = False
  Location = Application.ActiveWorkbook.Path
  
  Keywords = LoadKeywords(Location & EXCEL_1, EXCEL_1_KW_COL)
  
  Debug.Print "Keys=" & Keywords
  Dim L, CurrentDestRow As Long
  For Each L In Split(Keywords, ",")
    SearchKeywordAndCopy CurrentDestRow, Location & EXCEL_2, Location & EXCEL3, L, EXCEL_2_KW_COL, EXCEL_2_COPY_COLS, EXCEL_3_TARGET
  Next
  Application.ScreenUpdating = True
End Function

Public Function LoadKeywords(ByVal File As String, ByVal ColumnId As String, Optional ByVal FirstRow As Long = 2)
  Dim Wb1 As Workbook
  Dim Value As String, N As Long
  Set Wb1 = Workbooks.Open(File)
  
  N = FirstRow
  LoadKeywords = ""
  Do While True
    Value = Wb1.Sheets(1).Range(ColumnId & N).Text
    If Value = "" Then Exit Do
    LoadKeywords = LoadKeywords & IIf(LoadKeywords = "", "", ",") & Value
    N = N + 1
  Loop
  Wb1.Close SaveChanges:=False
End Function

Public Sub SearchKeywordAndCopy(ByRef CurrentDestRow As Long, ByVal FileSource As String, ByVal FileTarget As String, ByVal Keyword As String, ByVal SourceColumn As String, ByVal SourceCopyFrom As String, ByVal DestCopyTo As String)
  Dim WbSource As Workbook, WbDest As Workbook
  Dim Value As String, N As Long
  
  Set WbDest = Application.ActiveWorkbook
  Set WbSource = Workbooks.Open(FileSource)
  
  N = 2
  Do While True
    Value = WbSource.Sheets(1).Range(SourceColumn & N).Text
    If Value = "" Then Exit Do
    If Value <> Keyword Then GoTo NextRow
    
    Dim L, M As Long
    CurrentDestRow = CurrentDestRow + 1
    WbDest.Sheets(1).Range(DestCopyTo & CurrentDestRow).Value = Keyword
    M = 0
    For Each L In Split(SourceCopyFrom, ",")
      Dim CopyValue As String
      CopyValue = WbSource.Sheets(1).Range(L & N).Text
      M = M + 1
      WbDest.Sheets(1).Range(DestCopyTo & CurrentDestRow).Offset(, M).Value = CopyValue
    Next
    
NextRow:
    N = N + 1
  Loop
  
  WbSource.Close SaveChanges:=False
End Sub

Your setup as best I could understand it:

Excel_In1.xls

Excel_In2.xls

And… This is the code I wrote:

Option Explicit
Option Base 1
Sub CopyData()
    
    Dim XLout As Workbook   'Excel_Out.xls
    Dim XLin1 As Workbook   'Excel_In1.xls
    Dim XLin2 As Workbook   'Excel_In2.xls
    Dim ProductList         'Product/Company List from XLin1
    Dim ProductListO()      'Concatenated Version of above
    Dim DataList            'Product/Company List from XLin2
    Dim DataXcol            'Extra Data to pull from Column X in XLin2
    Dim DataZcol            'Extra Data to pull from Column Z in XLin2
    Dim Output()            'Output Array for XLout
    Dim i As Long           'Iterations
    Dim counter As Long     'Item number
    Dim TimeCount
    
    TimeCount = Timer
    
        ' >>> All Workbooks
    Set XLout = ThisWorkbook
    Set XLin1 = Workbooks.Open("C:UsersccritchlowDocumentsATestExcel_In1.xls")
    Set XLin2 = Workbooks.Open("C:UsersccritchlowDocumentsATestExcel_In2.xls")
        
        ' >>> Store Source Data in Arrays
    With XLin2.Sheets(1)
        DataList = .Range("A2:B" & .Range("A" & Rows.Count).End(xlUp).Row)
        DataXcol = .Range("X2:X" & .Range("A" & Rows.Count).End(xlUp).Row)
        DataZcol = .Range("Z2:Z" & .Range("A" & Rows.Count).End(xlUp).Row)
    End With
    
        ' >>> Store Product List Data in Arrays
    ProductList = XLin1.Sheets(1).Range("L2:M" & XLin1.Sheets(1).Range("M" & Rows.Count).End(xlUp).Row)
    ReDim ProductListO(1 To UBound(ProductList, 1))
    For i = 1 To UBound(ProductList, 1)
        ProductListO(i) = ProductList(i, 1) & "-" & ProductList(i, 2)
    Next i
    
        ' >>> Move entries from XLin2 (that exist on XLin1) into "Output" Array
    ReDim Preserve Output(UBound(DataList, 1), 3)
    counter = 1
    For i = 1 To UBound(DataList, 1)
        DataList(i, 1) = DataList(i, 1) & "-" & DataList(i, 2)
        If Not IsError(Application.Match(DataList(i, 1), ProductListO(), 0)) Then
            Debug.Print
            Output(counter, 1) = DataList(i, 2)
            Output(counter, 2) = DataXcol(i, 1)
            Output(counter, 3) = DataZcol(i, 1)
            counter = counter + 1
        End If
    Next i
    
        ' >>> Output to XLout
    XLout.Sheets(1).Range("A2").Resize(UBound(Output, 1), 3) = Output()

    Application.StatusBar = "Total Time to review " & UBound(DataList, 1) & " lines = " & Timer - TimeCount

End Sub

It does the following

  • Is stored on “Excel_Out.xls”
  • Opens both “Excel_In#.xls” workbooks
  • Stores all required data in arrays
  • Identifies data on XLin2 whose “company&productname” exist on XLin1
  • Outputs that data to “Excel_Out.xls”

This is how it looks:

enter image description here

Related Solutions

StringBuilder delete methods [closed]

I'd say this is fine. The intent is different. Lets try this for example: String builder sb = new StringBuilder(); sb.append("hello").append("hello"); sb.delete(0,5); sb.toString(); It prints "hello". Had you read the documentation, you'd see that the end is...

How to get specific element from array of type any in swift?

You should not be using JSONSerializer in Swift. A better option is a JSONDecoder. JSONDecoder will allow you to establish and preserve the type information for the data you've decoded. Here is an Playground example of how you would use JSONDecoder to handle...

How to make RecyclerView behave like Paragraph?

The answer is FlexBoxLayoutManager you can use it with RecyclerView put implementation 'com.google.android:flexbox:1.0.0' in your gradle file. Now setting up RecyclerView layout, <?xml version="1.0" encoding="utf-8"?> <RelativeLayout...

Piping commands after a piped xargs

You are almost there. In your last command, you can use -I to do the ls correctly -I replace-str Replace occurrences of replace-str in the initial-arguments with names read from standard input.  Also, unquoted blanks do not terminate input items; instead the...

create arrow using css

Try to use Font awsome LINK HTML: <i class="fa fa-arrow-right"></i> fa-arrow-right Yes, there are several ways of doing this. 1. With an image First of all, in order to do what you've suggested, you can indeed use an image - but instead of coloring...

accessing values structure within structure? [closed]

Just create an object of emp1 inside your main, and give it a value like below and it should be ok emp1 emp; emp.number.number1=3; //printf then with emp.number.number1 😉 You are accessing the value "number1" like emp1.number.number1 but here "emp" data type...

What’s wrong with this way to add rows to dataframe?

Try: data <- data.frame(A= character(0), B= character(0), stringsAsFactors=FALSE) data[1, ] <- c("AA", "BB") In your example, A and B are factors. I would suggest a different approach from the other answers. If A and B are something like names or ID...

Panagram python code [closed]

import string def isPanagram(sentence): alphabet = string.lowercase[:26] # list of letters a-z return all(letter in sentence.lower() for letter in alphabet) The function all will return true if all elements in a list are true The list comprehension inside goes...

VB Code explanation? [closed]

Declare a student name variable that we will call studentname as a string. Think of variables as you would do x and y in an algebraic equation. They are simply names for things of a particular type. In a maths equation x and y are numbers. A string is a...

remove null items from a multidimensional array in C#

Are your null objects always at the end of the multidimentional array? If so use something like this to remove the null items: private static void ReDimMultiObjects(ref object[,] arr, int length) { object[,] arrTemp = new object[length, 3];//New number of...

Check if string contains only one type of letter C# [closed]

Try this: private bool ContainsOnlyOneLetter(string String) { if(String.Length == 0) { return true; } for(int i = 0; i < String.Length;i++) { if(String.Substring(i,1) != String.Substring(0,1)) { return false; } } return true; } And you can use the function...

Couldn’t understand this SWIFT Fucntion [closed]

You're getting 120 because you're asking the tuple for the sum value twice. The tuple passed back is (min: Int, max: Int, sum: Int). In this case, sum is also index number 2 (min is index zero, max is index one). So in this case statistics.sum == statistics.2...

C++ Cli code stucked [closed]

The code you provided does not work on any numbers. The only thing it does is construct some SQL query check its result During the SQL-query-construction, the code does not assume any "numbers" to be provided. It actually uses a variable called...