Microsoft Office Tutorials and References
In Depth Information
Comparing Columns Using Various Criteria
Prompt:="Select the target cell", Title:="Unique list", _¶
Type:=8)¶
'Turn off screen updating¶
Application.ScreenUpdating = False¶
If Not RngDest Is Nothing Then¶
'If Not RngDest Is Nothing is code for "RngDest indicated"¶
UniqueList RngA, RngB, RngDest(1)¶
End If¶
End Select¶
'Restore screen updating¶
Application.ScreenUpdating = True¶
End Sub¶
' * * * * *¶
Sub HighlightInAandInB(ByVal Column1 As Range, _¶
ByVal Column2 As Range, Color As Long)¶
'Variable declaration¶
Dim Cll As Range¶
'Limit to the used range, to speed it up¶
Set Column1 = Intersect(Column1, Column1.Worksheet.UsedRange)¶
Set Column2 = Intersect(Column2, Column2.Worksheet.UsedRange)¶
'Remove the header¶
Set Column1 = Column1.Offset(1).Resize(Column1.Rows.Count - 1)¶
Set Column2 = Column2.Offset(1).Resize(Column2.Rows.Count - 1)¶
'Loop through the cells¶
For Each Cll In Column1.Cells¶
'Use the MATCH() function to see if the value is in there¶
If IsNumeric(Application.Match(Cll.Value, Column2, 0)) Then¶
'It is, so highlight it¶
Cll.Interior.Color = Color¶
'To delete the cell, use¶
'Cll.Delete Shift:=xlShiftUp¶
End If¶
Next Cll¶
End Sub¶
' * * * * *¶
Sub HighlightInANotInB(ByVal Column1 As Range, _¶
ByVal Column2 As Range, Color As Long)¶
'Variable declaration¶
Dim Cll As Range¶
'Limit to the used range, to speed it up¶
Set Column1 = Intersect(Column1, Column1.Worksheet.UsedRange)¶
Set Column2 = Intersect(Column2, Column2.Worksheet.UsedRange)¶
'Remove the header¶
Set Column1 = Column1.Offset(1).Resize(Column1.Rows.Count - 1)¶
Set Column2 = Column2.Offset(1).Resize(Column2.Rows.Count - 1)¶
'Loop through the cells¶
For Each Cll In Column1.Cells¶
'Use the MATCH() function to see if the value is in there¶
If IsError(Application.Match(Cll.Value, Column2, 0)) Then¶
'Is not, so highlight it¶
Cll.Interior.Color = Color¶
Exl
Search JabSto ::




Custom Search