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

Question

First of all really sorry for disturbing you people. I am new to VBA Excel and have no previous experience. I am trying a thing from last 2 weeks and still I am stuck at some point. I have written a small code that does not completely fulfill what I need to do.

If anybody help me out in this regard then I shall be really grateful to you.

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:

I have 2 separate Workbooks. 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 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.

Please have a look at the figures below for detailed information. I hope that i remained able to explain my query in words. I shall be grateful to you if somebody help me out. Thanks in anticipation.

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]

2:[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 pic 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 Workbook1 to Column B of Work book 2 infront of Words.

Like Infront 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 Workbook2 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.

Show source
| excel-vba   | vba   | excel   | macros   2017-01-06 22:01 1 Answers

Answers ( 1 )

  1. 2017-01-07 22:01

    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.

◀ Go back