Differences

This shows you the differences between two versions of the page.

--- microsoft_excel:macros:compare_rows [2021/08/04 14:05] – created peter
+++ microsoft_excel:macros:compare_rows [2021/08/04 15:03] (current) – removed peter
@@ Line 1: / Line 1: @@
-====== Microsoft Excel - Macros - 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>