Microsoft Office Tutorials and References
In Depth Information
Comparing Columns Using Various Criteria
View the Appendix to learn how to store this procedure
in a Standard module.
Option Explicit¶
' * * * * *¶
Sub CompareColumns()¶
'Variable declaration¶
Dim RngA As Range¶
Dim RngB As Range¶
Dim RngDest As Range¶
Dim WhatToDo As Long¶
'Continue if error occurs¶
On Error Resume Next¶
Set RngA = Application.InputBox( _¶
Prompt:="Select the first column (Including the header)", _¶
Title:="First column", Type:=8)¶
Set RngB = Application.InputBox( _¶
Prompt:="Select the second column (Including the header)", _¶
Title:="Second column", Type:=8)¶
On Error GoTo 0¶
'Did the user cancel?¶
If RngA Is Nothing Or RngB Is Nothing Then Exit Sub¶
'Make sure only one column is in each range¶
Set RngA = RngA.Columns(1)¶
Set RngB = RngB.Columns(1)¶
'Ask what to do¶
WhatToDo = CLng(Application.InputBox( _¶
Prompt:="- Enter '1' to highlight items that exist in 1 but " & _¶
"not in 2." & vbCrLf & _¶
"- Enter '2' to highlight items that appear in both columns." _¶
& vbCrLf & _¶
"- Enter '3' to extract a list of the unique items.", _¶
Title:="Compare columns", _¶
Type:=1))¶
'Turn off screen updating¶
Application.ScreenUpdating = False¶
Select Case WhatToDo¶
Case 1¶
'Highlight in red the ones that are in A but not in B¶
HighlightInANotInB RngA, RngB, RGB(255, 0, 0)¶
Case 2¶
'Highlight in blue the ones that are in A and are in B too¶
HighlightInAandInB RngA, RngB, RGB(0, 0, 255)¶
Case 3¶
'Generate a unique list of both, and put it in column¶
'user inputs¶
'Continue if error occurs¶
On Error Resume Next¶
'Restore screen updating for the inputbox¶
Application.ScreenUpdating = True¶
Set RngDest = Application.InputBox( _¶
Exl
Search JabSto ::




Custom Search