Wiki

This page is read only. You can view the source, but not change it. Ask your administrator if you think this is wrong.
====== Microsoft Excel - Macros - Compare - Compare Rows ======

<code excel>
Sub CompareRows()
    Dim Row1 As Range
    Dim Row2 As Range
 
  'Prompt user for the first row range to compare...
  '----------------------------------------------------
    Set Row1 = Application.InputBox("Select First Row to Compare", Type:=8)
   
    'Check that the range they have provided consists of only 1 row...
    If Row1.Rows.Count > 1 Then
   
      Do Until Row1.Rows.Count = 1
     
        MsgBox "You can only select 1 row"
        Set Row1 = Application.InputBox("Select First Row to Compare", Type:=8)
       
      Loop
     
    End If
  
  'Prompt user for the second row range to compare...
  '----------------------------------------------------
    Set Row2 = Application.InputBox("Select Second Row to Compare", Type:=8)
   
    'Check that the range they have provided consists of only 1 row...
    If Row2.Rows.Count > 1 Then
   
      Do Until Row2.Rows.Count = 1
     
        MsgBox "You can only select 1 row"
        Set Row2 = Application.InputBox("Select Second Row to Compare", Type:=8)
       
      Loop
     
    End If
   
 
  'Check both row ranges are the same size...
  '---------------------------------------------
  If Row2.Columns.Count <> Row1.Columns.Count Then
 
    Do Until Row2.Columns.Count = Row1.Columns.Count
   
      MsgBox "The second row must be the same size as the first"
      Set Row2 = Application.InputBox("Select Second Row to Compare", Type:=8)
     
    Loop
   
  End If
 
  'If entire rows 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 Row1.Columns.Count = 16384 Then

    Set Row1 = Range(Row1.Cells(1), Row1.Cells(ActiveSheet.UsedRange.Columns.Count))
    Set Row2 = Range(Row2.Cells(1), Row2.Cells(ActiveSheet.UsedRange.Columns.Count))

  End If
 
 
  'Perform the comparison and set cells that are the same to yellow
  '----------------------------------------------------------------
  Dim intCell As Long
 
  For intCell = 1 To Row1.Columns.Count
   
    If Row1.Cells(intCell) <> Row2.Cells(intCell) Then
   
      Row1.Cells(intCell).Interior.Color = vbYellow
      Row2.Cells(intCell).Interior.Color = vbYellow
     
    Else
    
      Row1.Cells(intCell).Interior.Color = vbWhite
      Row2.Cells(intCell).Interior.Color = vbWhite
     
    End If
 
  Next
  
End Sub

Sub CompareRows2(Row1 As Range, Row2 As Range)
 
  Dim intCell As Long
 
  For intCell = 1 To Row1.Columns.Count
   
    On Error Resume Next
    If Row1.Cells(intCell) <> Row2.Cells(intCell) Then
   
'        Row1.Cells(intCell).Interior.Color = vbYellow
        Row2.Cells(intCell).Interior.Color = vbYellow
     
    Else
    
'        Row1.Cells(intCell).Interior.Color = vbWhite
        Row2.Cells(intCell).Interior.Color = vbWhite
     
    End If
 
  Next
  
End Sub

Sub CheckRowSame()
'
' CheckRowSame Macro
'
  Dim Row1 As Range
  Dim Row2 As Range

  Dim Resource1 As String
  Dim Resource2 As String
  
  Dim Columns As Integer
  Dim ColumnLetter As String
        
    Application.Goto Range("A2"), True
    ActiveCell.Offset(1, 0).Range("A1").Select
    Resource1 = ActiveCell.Text

    Columns = ActiveSheet.UsedRange.Columns.Count
    If Columns = 3 Then ColumnLetter = "C"
    If Columns = 4 Then ColumnLetter = "D"
    If Columns = 5 Then ColumnLetter = "E"
    If Columns = 6 Then ColumnLetter = "F"
    If Columns = 7 Then ColumnLetter = "G"
    If Columns = 8 Then ColumnLetter = "H"
    If Columns = 9 Then ColumnLetter = "I"
    If Columns = 10 Then ColumnLetter = "J"
    If Columns = 11 Then ColumnLetter = "K"
    If Columns = 12 Then ColumnLetter = "L"
    If Columns = 13 Then ColumnLetter = "M"
    If Columns = 14 Then ColumnLetter = "N"
    If Columns = 15 Then ColumnLetter = "O"
    If Columns = 16 Then ColumnLetter = "P"
    If Columns = 17 Then ColumnLetter = "Q"
    If Columns = 18 Then ColumnLetter = "R"
    If Columns = 19 Then ColumnLetter = "S"
    If Columns = 20 Then ColumnLetter = "T"
    If Columns = 21 Then ColumnLetter = "U"
    If Columns = 22 Then ColumnLetter = "V"
    If Columns = 23 Then ColumnLetter = "W"
    If Columns = 24 Then ColumnLetter = "X"
    If Columns = 25 Then ColumnLetter = "Y"
    If Columns = 26 Then ColumnLetter = "Z"

    Do While Resource1 <> ""
        Set Row1 = Range("A" & ActiveCell.Row, ColumnLetter & ActiveCell.Row)
'        Resource1 = ActiveCell.Text
        
        ActiveCell.Offset(1, 0).Range("A1").Select
        Resource2 = ActiveCell.Text
        Set Row2 = Range("A" & ActiveCell.Row, ColumnLetter & ActiveCell.Row)
    
        If Resource1 = Resource2 Then
            Call CompareRows2(Row1, Row2)
            ActiveCell.Offset(1, 0).Range("A1").Select
            If Resource1 = ActiveCell.Text Then
                ActiveCell.Offset(-1, 0).Range("A1").Select
            Else
                Resource1 = ActiveCell.Text
            End If
        Else
            ActiveCell.Offset(1, 0).Range("A1").Select
            If Resource2 = ActiveCell.Text Then
                Resource1 = ActiveCell.Text
                ActiveCell.Offset(-1, 0).Range("A1").Select
            Else
                Resource1 = ActiveCell.Text
            End If
        End If
    Loop
        
    Application.Goto Range("A2"), True
        
End Sub
</code>