title: VBA Code causes error: "There isn't enough memory to complete this action"
body: <p>I have a consolidator tool that consolidates data from different worksheets. It can handle up to 1 million rows. However, when I click the button to check duplicates, there's an error that says "There isn't enough memory to do this action." I noticed that this error only happens when this macro runs. Please excuse the bad practice code as I am new to programming and this is what currently works right now. Is there anyway I can clean this code properly while still maintaining the functionality? </p>
  
  <p><strong>This is how it works:</strong> </p>
  
  <pre><code>| Employee ID | Status |  
  
  E100             Deactivated 
  
  E100            Activated 
  </code></pre>
  
  <p><strong>Turns into:</strong></p>
  
  <pre><code>| Employee ID | Status | Status | 
  
    E100        Deactivated  Activated
  </code></pre>
  
  <hr>
  
  <p><strong>Code:</strong></p>
  
  <pre><code>Sub mergeCategoryValues()
  Dim lngRow As Long
  Dim rngPrimaryKey As Range
  
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  
  
  'This is using activesheet, so make sure your worksheet is
  ' selected before running this code.
  Sheets("Consolidated").Activate
  
  With ActiveSheet
  
       Set rngPrimaryKey = .Range("A:Z").Find("Full Name")
  
      Dim columnToMatch As Integer
      columnToMatch = rngPrimaryKey.Column
  
      'Figure out the last row
      lngRow = .Cells(1000000, columnToMatch).End(xlUp).Row
  
      .Cells(columnToMatch).CurrentRegion.Sort key1:=.Cells(columnToMatch), Header:=xlYes
  
      For Each Cell In ActiveSheet.UsedRange
      If Cell.Value &lt;&gt; "" Then
      Cell.Value = Trim(Cell.Value)
      End If
      Next Cell
  
      'Loop through each row starting with last and working our way up.
      Do
  
          'Does this row match with the next row up accoding to the Job Number in Column A?
          If .Cells(lngRow, columnToMatch) = .Cells(lngRow - 1, columnToMatch) Then
  
              'Loop through columns B though P
              For i = 1 To 1000 '1000 max (?)
  
                  'Determine if the next row up already has a value. If it does leave it be
                  '   if it doesn't then use the value from this row to populate the next
                  '   next one up.
  
                  If .Cells(lngRow - 1, i).Value &lt;&gt; "" Then 'if not blank
                      If .Cells(lngRow - 1, i).Value &lt;&gt; .Cells(lngRow, i).Value Then 'if previous value is not equal to current value
                      ''''''
                      'INSERT NEW COLUMN HERE
                           If i &lt;&gt; 1 Then 'if column is not "Data Source"
                                  If .Cells(lngRow, i).Value &lt;&gt; "" Then
                                   Cells(lngRow - 1, i + 1).EntireColumn.Insert
                                  .Cells(lngRow - 1, i + 1).Value = .Cells(lngRow, i).Value
                                  'INSERT COLUMN NAME
                                  .Cells(1, i + 1).Value = .Cells(1, i).Value
                              End If
                          Else
                          .Cells(lngRow - 1, i).Value = .Cells(lngRow - 1, i).Value &amp; "; " &amp; .Cells(lngRow, i).Value
  
                      End If
                      Else
                     'Do Nothing
                     End If
                End If
              Next i
  
              'Now that we've processed all of the columns, delete this row
              '   as the next row up will have all the values
              .Rows(lngRow).Delete
          End If
  
          'Go to the next row up and do it all again.
          lngRow = lngRow - 1
      Loop Until lngRow = 1
  End With
  
  
  With ActiveWindow
      .SplitColumn = 1
      .SplitRow = 0
  End With
  
  ActiveWindow.FreezePanes = True
  
  Worksheets("Consolidated").Range("A:Z").Columns.AutoFit
  
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  
  If Err &lt;&gt; 0 Then
      MsgBox "An unexpected error no. " &amp; Err &amp; ": " _
      &amp; Err.Description &amp; " occured!", vbExclamation
  End If
  
  
  End Sub
  </code></pre>