PDA

View Full Version : How to compare data in a spreadsheet



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.

p45cal
07-04-2016, 08:41 AM
Confirm then that:
1. You want NO copyijng to take place.
2. Only highlighting of not-found rows.
3. Which sheet do you want the highlighting to be on?
4. You still want the three columns (A, B & C) on both sheets to be compared to look for a match/non-match.

vlookup_fan
07-04-2016, 01:02 PM
p45cal - Thank you so much!


Confirm then that:
1. You want NO copying to take place. I still want the copying to take place.
2. Only highlighting of not-found rows. I would like the code to highlight what it didn't find a match for. Probably asking too much to highlight what it did found then can ignore #1 - copying.
3. Which sheet do you want the highlighting to be on? if possible, I would like the highlighting to be on both Activebook1 and Original workbook.
4. You still want the three columns (A, B & C) on both sheets to be compared to look for a match/non-match. Yes. The three columns go together. Column A, B and C. If the Original workbook has something listed on Row 9 then activework could have it on Row29

The original macro above works great just need to add that it highlights what it did not find.

Thank you!

p45cal
07-05-2016, 02:37 AM
Totally confused by your answers.
Option Explicit

Sub Match_Copy()
'declare variables
Dim rA As Integer, cA As Integer, NotFound As Boolean
Dim rB As Integer, cB As Integer, rngToHighlight As Range
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
NotFound = True
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
NotFound = False
End If
Next rB
If NotFound Then
If rngToHighlight Is Nothing Then Set rngToHighlight = wsA.Range("A" & rA).Resize(, 3) Else Set rngToHighlight = Union(rngToHighlight, wsA.Range("A" & rA).Resize(, 3))
End If
Next rA
if not rngToHighlight Is Nothing ThenApplication.goto rngToHighlight Else msgbox "nothing to highlight"
'close original workbook without saving
'Workbooks("ILQ_original.xlsx").Close False
End Sub

vlookup_fan
07-05-2016, 05:21 PM
Totally confused by your answers.
Option Explicit

Sub Match_Copy()
'declare variables
Dim rA As Integer, cA As Integer, NotFound As Boolean
Dim rB As Integer, cB As Integer, rngToHighlight As Range
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
NotFound = True
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
NotFound = False
End If
Next rB
If NotFound Then
If rngToHighlight Is Nothing Then Set rngToHighlight = wsA.Range("A" & rA).Resize(, 3) Else Set rngToHighlight = Union(rngToHighlight, wsA.Range("A" & rA).Resize(, 3))
End If
Next rA
if not rngToHighlight Is Nothing ThenApplication.goto rngToHighlight Else msgbox "nothing to highlight"
'close original workbook without saving
'Workbooks("ILQ_original.xlsx").Close False
End Sub


p45cal - Thank you, thank you so much!
At first i got the compile error:Syntax on line


]if not rngToHighlight Is Nothing ThenApplication.goto rngToHighlight Else msgbox "nothing to highlight" I noticed that there is a need for space between ThenApplication and now it is working :). Do you know why it doesn't highlight, i mean the cells are selected but it doesn't highlight by color. Its okay, if not able to do it. At least, it gives me what i want. :)

Thank you so much!!

p45cal
07-06-2016, 03:49 AM
this at the bottom instead of what you've got:
Next rA
If Not rngToHighlight Is Nothing Then
rngToHighlight.Interior.ColorIndex = 3
Application.Goto rngToHighlight
Else
MsgBox "nothing to highlight"
End If
End Sub

vlookup_fan
07-06-2016, 08:08 PM
p45cal - works great. Thank you