You are here:

Excel/Matching 2 criteria and copying data from one workbook to another

Advertisement


Question
Hi Jan

I currently have a macro that matches 2 criteria from workbooks 1 and 2 and then copies certain data from workbook 2 to workbook 1.

My question is if there is no match for the data in workbook 2, then can I add a line of code to copy that line of data (which has no match) to the bottom of workbook 1?

Thanks

Best Regards
Derrik

Sub MatchAndCopyData()
  Dim WB1name    As String
  Dim WB2name    As String
  Dim WS1        As Worksheet
  Dim WS2        As Worksheet
  Dim LastRow2   As Long  'the last data-filled row in WS2
  Dim iRow1      As Long
  Dim iRow2      As Long

  WB1name = "Book1.xlsm"
  WB2name = "Book2.xlsx"

  'Assume first sheet in each workbook is the one of interest
  'Note: both workbooks must be open in Excel
  Set WS1 = Workbooks(WB1name).Worksheets(1)
  Set WS2 = Workbooks(WB2name).Worksheets(1)

  LastRow2 = WS2.Range("A65536").End(xlUp).Row

  For iRow1 = 2 To WS1.Range("A65536").End(xlUp).Row
     For iRow2 = 2 To LastRow2

        'Match first criteria
        If WS2.Cells(iRow2, "A") = WS1.Cells(iRow1, "A") Then

         'Match second criteria
         If WS2.Cells(iRow2, "C") = WS1.Cells(iRow1, "B") Then

         'both first and second criteria match, so transfer data to WS1
         WS1.Cells(iRow1, "C") = WS2.Cells(iRow2, "D")
         Exit For
         End If
        End If
     Next iRow2
  Next iRow1

End Sub

Answer
Hi Derrik,

Untested:

Sub MatchAndCopyData()
   Dim WB1name As String
   Dim WB2name As String
   Dim WS1 As Worksheet
   Dim WS2 As Worksheet
   Dim LastRow2 As Long    'the last data-filled row in WS2
   Dim iRow1 As Long
   Dim iRow2 As Long
   Dim bMatch As Boolean
   WB1name = "Book1.xlsm"
   WB2name = "Book2.xlsx"

   'Assume first sheet in each workbook is the one of interest
   'Note: both workbooks must be open in Excel
   Set WS1 = Workbooks(WB1name).Worksheets(1)
   Set WS2 = Workbooks(WB2name).Worksheets(1)

   LastRow2 = WS2.Range("A65536").End(xlUp).Row

   For iRow1 = 2 To WS1.Range("A65536").End(xlUp).Row
       For iRow2 = 2 To LastRow2
         bMatch = True
         'Match first criteria
         If WS2.Cells(iRow2, "A") = WS1.Cells(iRow1, "A") Then

         'Match second criteria
         If WS2.Cells(iRow2, "C") = WS1.Cells(iRow1, "B") Then

         'both first and second criteria match, so transfer data to WS1
         WS1.Cells(iRow1, "C") = WS2.Cells(iRow2, "D")
         Exit For
         Else
         bMatch = False
         End If
         Else
         bMatch = False
         End If
         If bMatch = False Then
         'No match found
         WS1.Range("A" & WS1.Cells.Count).Offset(1).EntireRow.Value = WS2.Cells(iRow2, 1).EntireColumn.Value
         End If
       Next iRow2
   Next iRow1

End Sub

About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

Excel

All Answers


Answers by Expert:


Ask Experts

Volunteer


Jan Karel Pieterse

Expertise

Excel and Excel/VBA questions

Experience

Excel MVP

Organizations
Self employed Excel developer

Education/Credentials
Bachelor in Chemical Engineering

Awards and Honors
Microsoft MVP award since 2002

Past/Present Clients
Shell, Fortis bank, ABN-AMRO bank, Morgan Stanley, ...

©2016 About.com. All rights reserved.