Home » excel » excel – Compare and Match 2 Columns and Copy the values of Matched items from next Column in Workbook 1 to Empty Column in Workbook 2 against Matched items

excel – Compare and Match 2 Columns and Copy the values of Matched items from next Column in Workbook 1 to Empty Column in Workbook 2 against Matched items

Posted by: admin April 23, 2020 Leave a comment

Questions:

I am new to VBA Excel.

Note:

I have written this program for 2 separate sheets but I have originally 2 separate workbooks and I want code to be written for 2 separate workbooks.

Question:

In Workbooks 1, Sheet name (AM_quote-overview_sales-inputs) I have 2 columns. Column A contains Topic Information and In Column B I have the data related to the information.

In Workbook 2 I have Column A containing the Topic Information words some are similar to what I have in AM_quote-overview_sales-inputs Sheet and some are not and in Column B. I need values to be copied from Column B of Workbook 1 sheet (AM_quote-overview_sales-inputs) on matching.

I want a macro in Workbook 2 (Sheet 1) that compares the values of Topic Information present in Column A with Topic Information Present in Column A of Workbook 1 Sheet (AM_quote-overview_sales-inputs) and then copies the values from Column B of workbook 1 sheet (AM_quote-overview_sales-inputs) to Column B of workbook 2 (Sheet 1) .

My written code compares the words but when I add new row in Sheet 1 of Workbook 2 the values that are copied from Column B of Workbook 1 to workbook 2 Column B are not accurate.

I need to compare 2 columns and copies the values of Column B of Workbook 1 Sheet (AM_quote-overview_sales-inputs) to Column B of Workbook 2 (Sheet1) for the compared or matched words from Column A of both sheets.

Have a look at the figures below for detailed information.

Code:

Private Sub CommandButton1_Click()

Dim oldRow As Integer

Dim newRow As Integer

Dim i As Integer

i = 1

For oldRow = 1 To 1170

    For newRow = 1 To 1170

       If StrComp((Worksheets("AM_quote-overview_sales-inputs").Cells(oldRow, 1).Text), (Worksheets("Sheet1").Cells(newRow, 1).Text), vbTextCompare) <> 0 Then
            i = oldRow
            Worksheets("Sheet1").Cells(i, 2) = " "
            Else
          Worksheets("Sheet1").Cells(i, 2) = Worksheets("AM_quote-overview_sales-inputs").Cells(newRow, 2)
            i = i + 1
            Exit For
        End If
    Next newRow
Next oldRow

End Sub

1 WorkBook 1 Sheet (AM_quote-overview_sales-inputs) Data
WorkBook 1 Sheet (AM_quote-overview_sales-inputs) Data

2 Workbook 2 (Sheet 1) Data
Workbook 2 (Sheet 1) Data

Example :

    Workbook 1          Sheet AQR Data      WorkBook 2         Sheet 1 
    Col A                  Col B            Col A               Col B
    Ford                   3                BMW                                                                         
    BMW                    4                Ford                                                        
    Jaguar                 5                Rolls Royce                                                       
    Rolls Royce            6                Jaguar                                                       

I have 2 Columns in workbooks.

I need a macro in Workbook 2 Sheet 1 that will pick up the values likes BMW etc from Column A and match these values present in Column A of Workbook 1 Sheet AQR and the words which gets matched it copies the values of words like 3, 4 from Column B of Workbook 1 to Column B of Workbook 2 in front of Words.

In front of BMW I need Value like 4 so after matching words I need 4 in Col B of Workbook 2.

  1. If no value is matched or new row is added in Workbook 2 which do not contain some word or value so it should be left empty and I need the values of matched words to be copied in front of respective words.
How to&Answers:

Please have a look at the line:

Worksheets("Sheet1").Cells(i, 2) = Worksheets("AM_quote-overview_sales-inputs").Cells(newRow, 2)

newRow variable is assigned to output, not to input loop – you should replace it with oldRow and it should work properly then.
You should also reverse the order of loops usage – you should use following logic (please see my Solution 1 example):

For newRow = 1 To 1170
    For oldRow = 1 To 1170
       ...
    Next oldRow
Next newRow

As if you find the result for particular value it may be replaced with ” ” in the next loop.

I have 3 additional remarks which don’t affect the result but may impact efficiency:

  1. You can also skip i variable as you can manage everything through variables used in loops.

  2. You don’t have to put output cell to ” ” everytime – with reversed order of loop you can do it before inner loop (I will show it in my example below).

  3. Instead of putting fix max row in the loop, you can search for it – please refer to my example below, where I identify the value for lrow_Input and lrow_Output instead of using ‘1170’.

Please see below two examples of solution of matching from one Workbook to another:
Assumptions to both solutions:

  1. WB_Input.xlsb is the file where you have ‘AM_quote-overview_sales-inputs’ worksheet and you want to match values from this WB (structure is as in your example – col A and col B to be used)
    enter image description here
  2. WB_Output.xlsb is the file where you want to have the results in col B for values in col A:
    enter image description here

  3. I don’t know where you want to put your code (in Input or Output file that’s why I put exact names of files – once you decide you can replace line assigning workbook to object (for example Set WB_Input = Workbooks("WB_Input.xlsb")) to assign it to ThisWorkbook.

Solution 1 is Your adjusted code:

Sub solution1()

Dim oldRow As Integer
Dim newRow As Integer
Dim lrow_input As Integer, lrow_output As Integer 'variables indicating last fulfilled rows
Dim WB_Input As Workbook
Dim WB_Output As Workbook
Dim WS_Input As Worksheet
Dim WS_Output As Worksheet


Set WB_Input = Workbooks("WB_Input.xlsb")
Set WB_Output = Workbooks("WB_Output.xlsb")

Set WS_Input = WB_Input.Worksheets("AM_quote-overview_sales-inputs")
Set WS_Output = WB_Output.Worksheets("Sheet1")

With WS_Input
    lrow_input = .Cells(.Rows.Count, 1).End(xlUp).Row
End With

With WS_Output
    lrow_output = .Cells(.Rows.Count, 1).End(xlUp).Row
End With

For newRow = 1 To lrow_output

WS_Output.Cells(newRow, 2).Value = "" 'you clear cell only once, not during each search

    For oldRow = 1 To lrow_input
        If (StrComp((WS_Input.Cells(oldRow, 1).Value2), (WS_Output.Cells(newRow, 1).Value2), vbTextCompare) = 0) Then
           WS_Output.Cells(newRow, 2).Value = WS_Input.Cells(oldRow, 2).Value
           Exit For
        End If

    Next oldRow
Next newRow

End Sub

Solution 2 uses Excel formulas VLOOKUP and IFERROR in the way that code is putting formula to the first cell and copies it to all below (till last needed row). Then calculates it – in case auto calculations are disabled – and pastes results as values:

Sub solution2()

Dim oldRow As Integer
Dim newRow As Integer
Dim lrow_output As Integer  'variable indicating last fulfilled row
Dim WB_Input As Workbook
Dim WB_Output As Workbook
Dim WS_Input As Worksheet
Dim WS_Output As Worksheet
Dim funcStr As String

Set WB_Input = Workbooks("WB_Input.xlsb")
Set WB_Output = Workbooks("WB_Output.xlsb")

Set WS_Input = WB_Input.Worksheets("AM_quote-overview_sales-inputs")
Set WS_Output = WB_Output.Worksheets("Sheet1")

With WS_Output
    lrow_output = .Cells(.Rows.Count, 1).End(xlUp).Row
End With

With WS_Input
    funcStr = "=IFERROR(VLOOKUP(" & Cells(1, 1).Address(False, False) & "," & "'[" & WB_Input.Name & "]" & .Name & "'!" & Range(.Columns(1), .Columns(2)).Address & ",2,0),"""")"
End With


With WS_Output
    .Cells(1, 2).Formula = funcStr
    .Cells(1, 2).Copy
    Range(.Cells(1, 2), .Cells(lrow_output, 2)).PasteSpecial xlPasteFormulas
    WS_Output.Calculate
    Range(.Cells(1, 2), .Cells(lrow_output, 2)).Copy
    Range(.Cells(1, 2), .Cells(lrow_output, 2)).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
End With

End Sub

Please let me know if I understood your problem properly and provided correct solution – if not, please let me know which assumptions are wrong so I adjust it.