Compare columns edit VBA code

**Hikaru12** · 06-05-2015, 08:51 AM

I copied this macro from the Microsoft website. It compares two columns of data for matches in both and then returns the matches in Column "B". What I'd like it to do is prompt for the first column, say "G" and the second column, say "I". I'd also like it to prompt what column the matches should be put in. It defaults to putting the matches in Column B but if I have data in Column A and B that must be near each other it makes it so I can't use this macro. Please ask for clarification if needed! Thanks.

Sub Find_Matches()
    Dim CompareRange As Variant, x As Variant, y As Variant
    ' Set CompareRange equal to the range to which you will
    ' compare the selection.
    Set CompareRange = Range("C1:C5")
    ' NOTE: If the compare range is located on another workbook
    ' or worksheet, use the following syntax.
    ' Set CompareRange = Workbooks("Book2"). _
    '   Worksheets("Sheet2").Range("C1:C5")
    '
    ' Loop through each cell in the selection and compare it to
    ' each cell in CompareRange.
    For Each x In Selection
        For Each y In CompareRange
            If x = y Then x.Offset(0, 1) = x
        Next y
    Next x
End Sub

**protonLeah** · 06-05-2015, 06:05 PM

Try this one:

Option Explicit
Sub Find_Matches()
    Dim CompareColumn   As Range, _
        CompareCell     As Range, _
        TestColumn      As Range, _
        TestCell        As Range, _
        ResultColumn    As Range, _
        CompareRows     As Long, _
        DestinationRow  As Long, _
        FoundVal        As Variant
        
        
    Set CompareColumn = Application.InputBox("Click in the  * COLUMN * to TEST", "Select TEST column", Type:=8)
    Set TestColumn = Application.InputBox("Click the column to compare to", "Select Compare column", Type:=8)
    Set ResultColumn = Application.InputBox("Click the column for the RESULTS", "Select RESULT column", Type:=8)
    CompareRows = WorksheetFunction.Max(Cells(Rows.Count, CompareColumn.Column).End(xlUp).Row, Cells(Rows.Count, TestColumn.Column).End(xlUp).Row)
        
    Set CompareColumn = CompareColumn.Resize(rowsize:=CompareRows)
    Set TestColumn = TestColumn.Resize(rowsize:=CompareRows)
    
    For Each TestCell In TestColumn
        If TestCell <> "" Then
            Set FoundVal = CompareColumn.Find(TestCell.Value)
            If FoundVal Is Nothing Then
                DestinationRow = DestinationRow + 1
                
                Cells(DestinationRow, ResultColumn.Column).Value = TestCell.Value
            End If 'try to find testcell value
        End If  'current test cell
    Next TestCell
End Sub