title: Comparison Macro
body: <p>I have a macro that does the following:</p>
  
  <p><strong>SETUP:</strong></p>
  
  <ol>
  <li>Compares a ID# between the "April Count" and "Prg-Srv Data" and turns the ones that are in common to a green cell background.</li>
  <li>Filters the common data (anything with a green cell background) and copies that to a new worksheet "Medicaid Report". Then clears the AutoFilter and and formats the worksheet to specified style.</li>
  <li>Filters and removes any rows that contain the word "Duplicate".</li>
  <li>Finally it compares the April Count to the Medicaid Report to see if anyone has been missed from the April Count list.</li>
  </ol>
  
  <p><strong>PROBLEM IS THIS:</strong></p>
  
  <p>When the macro is finished it is still "randomly" marking data in the April Count that is also in the Medicaid Report and I'm not sure what I have done wrong.</p>
  
  <p><em>Also if there is a more efficient way to do this let me know, this macro takes a long time to run and I'm not sure if its just because it has to do 5,000+ records or if I coded inefficiently.</em>  Thanks</p>
  
  <p><strong>CODE:</strong></p>
  
  <pre><code>Sub ComparePrgSrv()
      'Get the last row
      Dim Report As Worksheet
      Dim Report2 As Worksheet
      Dim Report3 As Worksheet
      Dim i, j, k As Integer
      Dim LastRow, LastRow2, LastRow3 As Integer
      Dim UniqueVal As New Collection
      Dim Val As String
  
      Set Report = Excel.Worksheets("April Count")
      Set Report2 = Excel.Worksheets("Prg-Srv Data")
      Set Report3 = Excel.Worksheets("Medicaid Report")
  
      LastRow = Report.UsedRange.Rows.count
      LastRow2 = Report2.UsedRange.Rows.count
      LastRow3 = Report3.UsedRange.Rows.count
  
      Application.ScreenUpdating = False
  
      'April Count to Program Services comparison.
      For i = 2 To LastRow2
          For j = 2 To LastRow
              If Report2.Cells(i, 1).Value &lt;&gt; "" Then 'This will omit blank cells at the end (in the event that the column lengths are not equal.
                  If InStr(1, Report.Cells(j, 1).Value, Report2.Cells(i, 1).Value, vbTextCompare) &gt; 0 Then
                      Report2.Cells(i, 1).Interior.Color = RGB(0, 102, 51) 'Dark green background
                      Report2.Cells(i, 1).Font.Color = RGB(0, 204, 102) 'Light green font color
                      Exit For
                  Else
                      Report2.Cells(i, 1).Interior.Color = xlNone 'Transparent background
                      Report2.Cells(i, 1).Font.Color = RGB(0, 0, 0) 'Black font color
                  End If
              End If
          Next j
      Next i
  
      'Filter Program Services to show correct data.
      Report2.Range("$A$1:$M$" &amp; LastRow2).AutoFilter Field:=1, Criteria1:=RGB(0, 102, 51), Operator:=xlFilterCellColor
  
      'Copy filtered data to new worksheet.
      Report2.Range("$A$1:$M$" &amp; LastRow2).SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Medicaid Report").Range("A1")
  
      'Clear filter selection on both sheets.
      Report.AutoFilterMode = False
      Report2.AutoFilterMode = False
  
      'Format cell colors on Medicaid sheet.
      Report3.UsedRange.Interior.Color = xlNone 'Transparent background
      Report3.UsedRange.Font.Color = RGB(0, 0, 0) 'Black font color
  
      Report3.Range("$A$1:$M$1").Interior.Color = RGB(31, 73, 125) 'Blue background
      Report3.Range("$A$1:$M$1").Font.Color = RGB(255, 255, 255) 'White font color
  
      'Filter and Delete Rows Containing "DUPLICATE"
      With ActiveSheet
      .AutoFilterMode = False
      With Range("B1", Range("B" &amp; Rows.count).End(xlUp))
          .AutoFilter 1, "*DUPLICATE*"
          On Error Resume Next
          .Offset(1).SpecialCells(12).EntireRow.Delete
      End With
      .AutoFilterMode = False
      End With
  
      'April Count to Medicaid Report comparison.
      For i = 2 To LastRow
          For j = 2 To LastRow3
              If Report.Cells(i, 1).Value &lt;&gt; "" Then 'This will omit blank cells at the end (in the event that the column lengths are not equal.
                  If InStr(1, Report3.Cells(j, 1).Value, Report.Cells(i, 1).Value, vbTextCompare) &gt; 0 Then
                      Report.Cells(i, 1).Interior.Color = xlNone 'Transparent background
                      Report.Cells(i, 1).Font.Color = RGB(0, 0, 0) 'Black font color
                      Exit For
                  Else
                      Report.Cells(i, 1).Interior.Color = RGB(156, 0, 6) 'Dark red background
                      Report.Cells(i, 1).Font.Color = RGB(255, 199, 206) 'Light red font color
                  End If
              End If
          Next j
      Next i
  End Sub
  </code></pre>
  
  <p><strong>Workbook Setup:</strong>
  <img src="https://i.stack.imgur.com/O4SFR.jpg" alt="enter image description here"></p>