none
Use VBA to compare two columns in Excel and highlight the cells that are similar

    Question

  • HI,

    .
    I have a workbook containing the data ..I am trying to create a macro in excel which compares values in each column and highlights the cells which have similar values...

     
    Pls help
    Monday, April 02, 2007 10:46 AM

Answers

  • Try this. It's a bit long winded and there's probably a much easier way of doing the same thing, but it works nonetheless. I simply assigned it a keyboard shortcut (e.g. Ctrl+SHIFT & C) from the Tools > Macros menu. It works by prompting you to select the columns or ranges you wish to compare and then performs the comparison. It changes cells that are the same to yellow, but you can change this to whatever you wish. It will work on whatever worksheet is active

     

    Sub CompareColumns()

     

      Dim Column1 As Range
        Dim Column2 As Range
     
      'Prompt user for the first column range to compare...
      '----------------------------------------------------
        Set Column1 = Application.InputBox("Select First Column to Compare", Type:=8)
       
        'Check that the range they have provided consists of only 1 column...
        If Column1.Columns.Count > 1 Then
       
          Do Until Column1.Columns.Count = 1
         
            MsgBox "You can only select 1 column"
            Set Column1 = Application.InputBox("Select First Column to Compare", Type:=8)
           
          Loop
         
        End If
      
      'Prompt user for the second column range to compare...
      '----------------------------------------------------
        Set Column2 = Application.InputBox("Select Second Column to Compare", Type:=8)
       
        'Check that the range they have provided consists of only 1 column...
        If Column2.Columns.Count > 1 Then
       
          Do Until Column2.Columns.Count = 1
         
            MsgBox "You can only select 1 column"
            Set Column2 = Application.InputBox("Select Second Column to Compare", Type:=8)
           
          Loop
         
        End If
       
     
      'Check both column ranges are the same size...
      '---------------------------------------------
      If Column2.Rows.Count <> Column1.Rows.Count Then
     
        Do Until Column2.Rows.Count = Column1.Rows.Count
       
          MsgBox "The second column must be the same size as the first"
          Set Column2 = Application.InputBox("Select Second Column to Compare", Type:=8)
         
        Loop
       
      End If
     
      'If entire columns have been selected (e.g. $AEmbarrassedA), limit the range sizes to the
      'UsedRange of the active sheet. This stops the routine checking the entire sheet
      'unnecessarily.
      '-------------------------------------------------------------------------------
      If Column1.Rows.Count = 65536 Then


        Set Column1 = Range(Column1.Cells(1), Column1.Cells(ActiveSheet.UsedRange.Rows.Count))
        Set Column2 = Range(Column2.Cells(1), Column2.Cells(ActiveSheet.UsedRange.Rows.Count))


      End If
     
     
      'Perform the comparison and set cells that are the same to yellow
      '----------------------------------------------------------------
      Dim intCell As Long
     
      For intCell = 1 To Column1.Rows.Count
       
        If Column1.Cells(intCell) = Column2.Cells(intCell) Then
       
          Column1.Cells(intCell).Interior.Color = vbYellow
          Column2.Cells(intCell).Interior.Color = vbYellow
         
        End If
     
      Next
     

    End Sub

    Monday, April 02, 2007 4:05 PM

All replies

  • Try this. It's a bit long winded and there's probably a much easier way of doing the same thing, but it works nonetheless. I simply assigned it a keyboard shortcut (e.g. Ctrl+SHIFT & C) from the Tools > Macros menu. It works by prompting you to select the columns or ranges you wish to compare and then performs the comparison. It changes cells that are the same to yellow, but you can change this to whatever you wish. It will work on whatever worksheet is active

     

    Sub CompareColumns()

     

      Dim Column1 As Range
        Dim Column2 As Range
     
      'Prompt user for the first column range to compare...
      '----------------------------------------------------
        Set Column1 = Application.InputBox("Select First Column to Compare", Type:=8)
       
        'Check that the range they have provided consists of only 1 column...
        If Column1.Columns.Count > 1 Then
       
          Do Until Column1.Columns.Count = 1
         
            MsgBox "You can only select 1 column"
            Set Column1 = Application.InputBox("Select First Column to Compare", Type:=8)
           
          Loop
         
        End If
      
      'Prompt user for the second column range to compare...
      '----------------------------------------------------
        Set Column2 = Application.InputBox("Select Second Column to Compare", Type:=8)
       
        'Check that the range they have provided consists of only 1 column...
        If Column2.Columns.Count > 1 Then
       
          Do Until Column2.Columns.Count = 1
         
            MsgBox "You can only select 1 column"
            Set Column2 = Application.InputBox("Select Second Column to Compare", Type:=8)
           
          Loop
         
        End If
       
     
      'Check both column ranges are the same size...
      '---------------------------------------------
      If Column2.Rows.Count <> Column1.Rows.Count Then
     
        Do Until Column2.Rows.Count = Column1.Rows.Count
       
          MsgBox "The second column must be the same size as the first"
          Set Column2 = Application.InputBox("Select Second Column to Compare", Type:=8)
         
        Loop
       
      End If
     
      'If entire columns have been selected (e.g. $AEmbarrassedA), limit the range sizes to the
      'UsedRange of the active sheet. This stops the routine checking the entire sheet
      'unnecessarily.
      '-------------------------------------------------------------------------------
      If Column1.Rows.Count = 65536 Then


        Set Column1 = Range(Column1.Cells(1), Column1.Cells(ActiveSheet.UsedRange.Rows.Count))
        Set Column2 = Range(Column2.Cells(1), Column2.Cells(ActiveSheet.UsedRange.Rows.Count))


      End If
     
     
      'Perform the comparison and set cells that are the same to yellow
      '----------------------------------------------------------------
      Dim intCell As Long
     
      For intCell = 1 To Column1.Rows.Count
       
        If Column1.Cells(intCell) = Column2.Cells(intCell) Then
       
          Column1.Cells(intCell).Interior.Color = vbYellow
          Column2.Cells(intCell).Interior.Color = vbYellow
         
        End If
     
      Next
     

    End Sub

    Monday, April 02, 2007 4:05 PM
  • Hi ! thank you for this it is excellent, Can you modify this to check more than one column, that would be perfect !
    frank

    Wednesday, January 23, 2008 4:14 AM
  • Hi, I would like to accomplish the following: I have two excel worksheets. Each worksheet contains different number of coloumns, but the same number of rows. I would like to: A. Match a specific column from worksheet 1 to worksheet 2. B. If the values match, then copy that entire row into a NEW worksheet. I would like to use VBA coding as the worksheet size changes. Any help would be appreciated. Thanks.
    Monday, September 05, 2011 3:24 PM
  • This macro uses column C as the comparison column:

     

    Sub vba_freak()
    Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet
    Dim i3 As Long, j As Long, jj As Long
    i3 = 1
    Dim CheckColumn As Integer
    CheckColumn = 3
    Set s1 = Sheets("s1")
    Set s2 = Sheets("s2")
    Set s3 = Sheets("s3")
    j = s1.Cells(Rows.Count, CheckColumn).End(xlUp).Row
    For jj = 1 To j
        If s1.Cells(jj, CheckColumn).Value = s2.Cells(jj, CheckColumn).Value Then
            s1.Cells(jj, CheckColumn).EntireRow.Copy s3.Cells(i3, 1)
            i3 = i3 + 1
        End If
    Next
    End Sub

     

     


    gsnu201106
    Monday, September 05, 2011 5:22 PM