title: Optimizing VBA / Excel Macro Code (Finding Duplicates in Large Sheet)
body: <p>I haven't really ever coded in VBA or anything of the sort except short little things in VB done years ago. This is my attempt at writing some code that will search through a excel sheet database of client accounts and search for possible duplicate accounts. Sadly, on the machine that I need to run this on, it can only handle about 3,500 entries without crashing Excel. I contribute this to both my code being horribly unoptimized as-well as the machine being slow. </p>
  
  <p>What can be done to optimize the following code, and what best practices in VBA should I use in the future?</p>
  
  <pre><code>'Essentially, this loops through each row in the sheet
  'For each row, it loops through every row after it, searching for duplicates of itself (skipping over a rows that have previously been marked as duplicates)
  'Duplicates are defined by entries that meet a 'threshhold' of similarity
  'The threshhold is defined as the number '5', first and last names are each two points, address and email address are one point
  'That means that in order for an entry to meet the thresshold, the first and last name must be the same, and it must also have either the same address or email
  'When duplicates are found, the duplicate column is marked as 'Yes' for that row, and the first occurence column is marked with a number defining the row number where the account first appeared
  
  Sub Main():
      Dim lNameCol, fNameCol, addressCol, emailCol, duplicateCol, fOccurenceCol As String
  
      'Defines the column letters for the various data fields
      lNameCol = "A"
      fNameCol = "B"
      addressCol = "C"
      emailCol = "D" 
      duplicateCol = "E"   'The column where a entry/row will be marked as being a duplicate
      fOccurenceCol = "F"  'The column that contains the row number where a duplicate accounts first occurence was found
  
      Call Duplicates(lNameCol, fNameCol, addressCol, emailCol, duplicateCol, fOccurenceCol)
  End Sub
  
  'Gets number of rows in currently active sheet
  Function RowCount():
      Application.ActiveSheet.UsedRange
      RowCount = Worksheets("Sheet1").UsedRange.Rows.Count
  End Function
  
  'Finds and labels duplicates
  Sub Duplicates(ByVal lNameCol As String, ByVal fNameCol As String, ByVal addressCol As String, ByVal emailCol As String, ByVal duplicateCol As String, ByVal fOccurenceCol As String)
      Dim lRowCount As Integer
      lRowCount = RowCount()
  
      'Loops through each row in the sheet
      For i = 1 To lRowCount
  
          Dim duplicate, lastName, firstName, email, address As String
  
          'Sets these variables' values corresponding cell value in row 'i'
          'UCase capitilizes things to make entries case-insensitive
          duplicate = UCase(Range(duplicateCol &amp; i).Value)
          lastName = UCase(Range(lNameCol &amp; i).Value)
          firstName = UCase(Range(fNameCol &amp; i).Value)
          email = UCase(Range(emailCol &amp; i).Value)
          address = UCase(Range(addressCol &amp; i).Value)
  
          'Checks to make sure row has not already been marked a duplicate, if it hasn't it continues
          If (StrComp(duplicate = "YES", vbTextCompare) = 1) Then
  
              'Loops through every row after the current row (row 'i')
              For n = (i + 1) To lRowCount
  
                  'duplicateThreshold is an integer that defines the threshhold of similarity that rows need to have in order to be labeled a duplicate
                  Dim duplicateThreshhold As Integer
                  Dim lastName2, firstName2, email2, address2 As String
  
                  duplicateThreshhold = 0
  
                  'These are the entry variables for account entry at row 'n' being compared to the account entry at row 'i'
                  lastName2 = UCase(Range(lNameCol &amp; n).Value)
                  firstName2 = UCase(Range(fNameCol &amp; n).Value)
                  email2 = UCase(Range(emailCol &amp; n).Value)
                  address2 = UCase(Range(addressCol &amp; n).Value)
  
                  'Adds 2 points to threshhold if first name is the same
                  If lastName = lastName2 Then
                      duplicateThreshhold = duplicateThreshhold + 2
  
                  End If
  
                  'Adds 2 points to threshold if last name is the same
                  If firstName = firstName2 Then
                      duplicateThreshhold = duplicateThreshhold + 2
                  End If
  
                  'The remaining two fields give 1 point each to the thresshold
                  'As long as the sum of the points given by first and last name is always greater than half of the threshhold, first and last name will always be required
  
                  If email = email2 Or address = address2 Then
                      duplicateThreshhold = duplicateThreshhold + 1
                  End If
  
                  If duplicateThreshhold &gt; 4 Then
                     'Labels duplicate entries as duplicates
                      Range(duplicateCol &amp; i).Value = "Yes"
                      Range(duplicateCol &amp; n).Value = "Yes" 
  
                     'Labels duplicate entries with the first occurence of that entry
                      Range(fOccurenceCol &amp; i).Value = i 'Labels first occurence account's row number
                      Range(fOccurenceCol &amp; n).Value = i
  
                  End If
  
              Next
          End If
      Next
  
  
  End Sub
  </code></pre>