title: Remove duplicate based on value
body: <p>I have code that will delete the entire row if such conditions are met:</p>
  <ol>
  <li>ID are duplicate AND</li>
  <li>In the duplicate ID the cond1 = Hello AND</li>
  <li>In the duplicate ID the cond2 = 1</li>
  </ol>
  <p>See sample table below. The highlighted should be deleted.
  The code is slow thus finding a way to optimize it.</p>
  <p><a href="https://i.stack.imgur.com/WRN5z.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/WRN5z.png" alt="enter image description here" /></a></p>
  <pre class="lang-vb prettyprint-override"><code>Sub RemoveDupl()
  
      'to check if the Incident ID has duplicates
      lastRow = Worksheets(&quot;Sheet1&quot;).Cells(Rows.Count, 6).End(xlUp).Row
      
      'loop to check all the rows
      For i = 2 To lastRow
          Set rangeIDCheck = Range(&quot;A:A&quot;)
          For j = 2 To lastRow
              If WorksheetFunction.CountIf(rangeIDCheck, Worksheets(&quot;Sheet1&quot;).Cells(j, 6).Value) &gt; 1 And Worksheets(&quot;Sheet1&quot;).Cells(j, 15).Value = &quot;Hello&quot; And Worksheets(&quot;Sheet1&quot;).Cells(j, 16).Value = &quot;1&quot; Then
                  Rows(j).EntireRow.Delete
              End If
          Next
      Next
  
  End Sub
  </code></pre>
  <p>My second code. I only need how to get the current row number. I searched but got nothing. Enclosed in * is the one I need to be replaced.</p>
  <pre class="lang-vb prettyprint-override"><code>Sub RemoveDupl()
          
      'turning off
      Application.ScreenUpdating = False
      Application.DisplayAlerts = False
      Application.Calculation = xlCalculationManual
  
      Dim Rng As Range
      Dim cel As Range
      Dim Counter As Integer
  
      Set Rng = Range(Range(&quot;A1&quot;), Range(&quot;A&quot; &amp; Rows.Count).End(xlUp))
          
      For Each cel In Rng
          If WorksheetFunction.CountIf(Rng, cel.Value) &gt; 1 And Cells(**Rng.Row**, 15) = &quot;Hello&quot; And Cells(**Rng.Row**, 16) = &quot;1&quot; Then
              cel.EntireRow.Delete
              'cel.EntireRow.Interior.Color = 5296274
          End If
      Next cel
  
      'turning on
      Application.ScreenUpdating = True
      Application.DisplayAlerts = True
      Application.Calculation = xlCalculationAutomatic
      
  End Sub
  </code></pre>