vlookup_fan
07-03-2016, 09:25 PM
Hi Guys,
I searched the forum and found a code posted by Yongle and I would like to use this code but need some help modifying it. Can someone please help?
I would like the code to highlight what it did not find a match for when it compared Workbook1 to Original Workbook.
Also, can the code below be change so that it doesn't need to access the original workbook rather compare to sheet1 to sheet2 in the same workbook1.
'open original workbook Workbooks.Open ("C:\Desktop\TEST1.xlsm") ' << put in file name including full path
Not able to post link to the topic - "How to compare data in a spreadsheet and paste matched values in another sheet"
Dated 3-24-2015
Below is the code:
Option Explicit
Sub Match_Copy()
'declare variables
Dim rA As Integer, cA As Integer
Dim rB As Integer, cB As Integer
Dim LastRowA As Long, LastRowB As Long, NextRowC As Long
Dim wsA As Worksheet, wsB As Worksheet, wsC As Worksheet
'target workbook sheets and last row
Set wsC = ActiveWorkbook.Sheets("Sheet2") ' << sheet to paste matched values
Set wsB = ActiveWorkbook.Sheets("Sheet1") ' << sheet containing compare values
LastRowB = wsB.Cells(Rows.Count, "A").End(xlUp).Row
'open original workbook
Workbooks.Open ("d:\documents\ILQ_original.xlsx") ' << put in file name including full path
'original workbook sheet and last row
Set wsA = ActiveWorkbook.Sheets("Sheet1") ' << sheet in original workbook
LastRowA = wsA.Cells(Rows.Count, "A").End(xlUp).Row
'compare the 3 columns in the 2 workbooks and copy/paste to sheet2 if a match is found
For rA = 2 To LastRowA
For rB = 2 To LastRowB
If wsA.Range("A" & rA) = wsB.Range("A" & rB) And wsA.Range("B" & rA) = wsB.Range("B" & rB) And wsA.Range("C" & rA) = wsB.Range("C" & rB) Then
wsA.Range("A" & rA & ":C" & rA).Copy
NextRowC = wsC.Range("A1048576").End(xlUp).Offset(1, 0).Row
wsC.Range("A" & NextRowC & ":C" & NextRowC).PasteSpecial Paste:=xlPasteAll
Else
End If
Next rB
Next rA
'close original workbook without saving
Workbooks("ILQ_original.xlsx").Close False
End Sub
Your help would be greatly appreciated.
thanks so much.
I searched the forum and found a code posted by Yongle and I would like to use this code but need some help modifying it. Can someone please help?
I would like the code to highlight what it did not find a match for when it compared Workbook1 to Original Workbook.
Also, can the code below be change so that it doesn't need to access the original workbook rather compare to sheet1 to sheet2 in the same workbook1.
'open original workbook Workbooks.Open ("C:\Desktop\TEST1.xlsm") ' << put in file name including full path
Not able to post link to the topic - "How to compare data in a spreadsheet and paste matched values in another sheet"
Dated 3-24-2015
Below is the code:
Option Explicit
Sub Match_Copy()
'declare variables
Dim rA As Integer, cA As Integer
Dim rB As Integer, cB As Integer
Dim LastRowA As Long, LastRowB As Long, NextRowC As Long
Dim wsA As Worksheet, wsB As Worksheet, wsC As Worksheet
'target workbook sheets and last row
Set wsC = ActiveWorkbook.Sheets("Sheet2") ' << sheet to paste matched values
Set wsB = ActiveWorkbook.Sheets("Sheet1") ' << sheet containing compare values
LastRowB = wsB.Cells(Rows.Count, "A").End(xlUp).Row
'open original workbook
Workbooks.Open ("d:\documents\ILQ_original.xlsx") ' << put in file name including full path
'original workbook sheet and last row
Set wsA = ActiveWorkbook.Sheets("Sheet1") ' << sheet in original workbook
LastRowA = wsA.Cells(Rows.Count, "A").End(xlUp).Row
'compare the 3 columns in the 2 workbooks and copy/paste to sheet2 if a match is found
For rA = 2 To LastRowA
For rB = 2 To LastRowB
If wsA.Range("A" & rA) = wsB.Range("A" & rB) And wsA.Range("B" & rA) = wsB.Range("B" & rB) And wsA.Range("C" & rA) = wsB.Range("C" & rB) Then
wsA.Range("A" & rA & ":C" & rA).Copy
NextRowC = wsC.Range("A1048576").End(xlUp).Offset(1, 0).Row
wsC.Range("A" & NextRowC & ":C" & NextRowC).PasteSpecial Paste:=xlPasteAll
Else
End If
Next rB
Next rA
'close original workbook without saving
Workbooks("ILQ_original.xlsx").Close False
End Sub
Your help would be greatly appreciated.
thanks so much.