|
|
|
Question : Matching data from two Worksheets, and highlighting matching rows
|
|
Hi again...ok I've got another situation in Excel that will most likely need to be solved by a Macro, and I would like some help because I have no VB skills yet.
I have two worksheets in an Excel workbook. Sheet1 has all the data for a final report that I need to submit. Sheet2 has some data from a query that I need to compare to the data on Sheet1.
I need the macro to look at 3 columns, the ID, Flag, and Income from Sheet2, if this combination is found on the same 3 columns in Sheet1 I need the entire row where the match was found on Sheet2 to be highlighted in Blue. If a match on those 3 is not made, then I need it highlighted in Red.
More Clarification: Sheet1 contains 1,000 records, Sheet2 contains 20,000....furthermore....Let's say there are 50 records with ID 12345 on Sheet1, and 100 records with ID 12345 on Sheet2. I need the Macro to first look for a match on ID, then Gender, then Income, if all 3 match up, highlight that row in Blue, if all 3 do not match up, highlight row in Red. But ONLY FOR ID 12345 do I need to see the row highlighted. I think if we didn't first look for a match on ID, then the rest of Sheet2 would end up highlighted in Red, and that's not what I need. For each ID where a match is found I need to see Blue and Red highlighted rows. If there is no match made on ID, then do nothing to that row.
So for Each ID + Gender + Income on Sheet1, I need them matched and compared on Sheet2.
Am I making any sense? You guys have been fantastic so far, and I appreciate your help immensley.
|
Answer : Matching data from two Worksheets, and highlighting matching rows
|
|
Brian,
I fixed the bug with worksheet Temp, and changed the code to match your column assignments. To test it, I added blank columns to your sample datasheet.
In reading the explanatory note on your sample sheet, I realized that you may want only one row on CLA_OFF_CLO_DET colored blue for a matching row in CLAQuery. Before, I had been coloring all matches (to all four fields) blue--even if there were more matching rows on CLA_OFF_CLO_DET than on CLAQuery. The following code offers you a choice of how to proceed--it's set up for a 1:1 match, but the lines are commented if you want the other approach.
Brad
Sub Highlighter()
Dim rg1 As Range, rg2 As Range, rgRed As Range, rgBlue As Range
Dim rgID1 As Range, rgID2 As Range, crit2 As Range, rgTemp As Range
Dim rgCat1 As Range, rgCat2 As Range
Dim nRow1 As Long, nRow2 As Long, i As Long, j As Long, ID As Long
Dim ws1 As Worksheet, ws2 As Worksheet, wsTemp As Worksheet
Dim X1 As Variant, X2 As Variant, ID1 As Variant, ID2 As Variant
Dim str As String
Dim SheetTest As Object
Application.ScreenUpdating = False
'Add a Temp worksheet if none exists
On Error Resume Next
Set SheetTest = Worksheets("Temp")
If err = 0 Then
Set wsTemp = Worksheets("Temp")
wsTemp.UsedRange.Clear
Else
ActiveWorkbook.Worksheets.Add
Set wsTemp = ActiveSheet
wsTemp.Name = "Temp"
End If
On Error GoTo 0
Set rgTemp = wsTemp.Cells(1, 1)
Set ws1 = Worksheets("CLA_OFF_CLO_DET")
Set ws2 = Worksheets("CLAQuery")
Set rg1 = Range(ws1.Cells(2, 1), ws1.Cells(65536, 20).End(xlUp))
Set rg2 = Range(ws2.Cells(2, 1), ws2.Cells(65536, 6).End(xlUp))
X1 = rg1.Cells
X2 = rg2.Cells
nRow1 = rg1.Rows.Count
nRow2 = rg2.Rows.Count
Set rgID1 = Range(ws1.Cells(1, 4), ws1.Cells(nRow1 + 1, 4))
Set rgID2 = Range(ws2.Cells(1, 2), ws2.Cells(nRow2 + 1, 2))
ws1.Cells.Interior.ColorIndex = 0
wsTemp.Cells(1, 6) = "ID"
Set crit2 = Range(wsTemp.Cells(1, 6), wsTemp.Cells(2, 6))
rgID2.AdvancedFilter action:=xlFilterCopy, criteriarange:=crit2, copytorange:=rgTemp, unique:=True
ID1 = Intersect(rg1, ws1.Columns(4)).Cells
ID2 = Range(wsTemp.Cells(2, 1), wsTemp.Cells(65536, 1).End(xlUp)).Cells
For i = 1 To UBound(ID2)
ID = ID2(i, 1)
For j = 1 To nRow1
If ID1(j, 1) = ID Then
If rgRed Is Nothing Then
Set rgRed = ws1.Cells(j + 1, 1).EntireRow
Else
Set rgRed = Union(rgRed, ws1.Cells(j + 1, 1).EntireRow)
End If
End If
Next j
Next i
wsTemp.Cells.ClearFormats
ReDim ID1(1 To nRow1, 1)
ReDim ID2(1 To nRow2, 1)
For j = 1 To nRow1
'Concatenate ID,Gender,Name,Income
ID1(j, 1) = X1(j, 4) & X1(j, 7) & X1(j, 16) & X1(j, 20)
Next j
For i = 1 To nRow2
'Concatenate ID,Gender,Name,Income
ID2(i, 1) = X2(i, 2) & X2(i, 6) & X2(i, 4) & X2(i, 5)
Next i
For i = 1 To nRow2
str = ID2(i, 1)
For j = 1 To nRow1
If ID1(j, 1) = str Then
If rgBlue Is Nothing Then
Set rgBlue = ws1.Cells(j + 1, 1).EntireRow
Else
'Pick either this approach or the following one
'The next line colors blue all lines on CLA_OFF_CLO_DET that match this one
'Set rgBlue = Union(rgBlue, ws1.Cells(j + 1, 1).EntireRow)
'The next four lines color blue only one line in CLA_OFF_CLO_DET that matches this one
If Intersect(ws1.Cells(j + 1, 1), rgBlue) Is Nothing Then
Set rgBlue = Union(rgBlue, ws1.Cells(j + 1, 1).EntireRow)
Exit For
End If
End If
End If
Next j
Next i
rgRed.Interior.ColorIndex = 3 'Red highlight
rgBlue.Interior.ColorIndex = 8 'Blue highlight
Application.ScreenUpdating = True
End Sub
|
|
|
|
|
|
|
