Excel crashes when comparing two columns VBA macro

Question

I have two columns which I am comparing for identical entries, and pushing the matches to another column through Offset. When I run the macro I've built (off of some Microsoft canned code) it essentially freezes and crashes, since it is a nested for each loop based on cells that are used, I figured it would end upon reaching an empty cell, but I fear I may be in a infinite loop. Any help will be much appreciated.

Dim myRng As Range
Dim lastCell As Long

Dim lastRow As Long
lastRow = ActiveSheet.UsedRange.Rows.Count

Dim c As Range
Dim d As Range

For Each c In Worksheets("Sheet1").Range("AT2:AT" & lastRow).Cells
    For Each d In Worksheets("Sheet1").Range("AU2:AU" & lastRow).Cells
        If c = d Then c.Offset(0, 1) = c
    Next d
Next c

Answer 1

Try this:

Dim lastRow, currentRow, compareRow As Long
Dim found As Boolean

lastRow = Range("AT2").End(xlDown).Row

For currentRow = 2 To lastRow
    compareRow = 2
    found = False
    Do While compareRow <= lastRow And Not found
        If Range("AT" & currentRow).Value = Range("AU" & compareRow).Value Then
            found = True
            Range("AV" & currentRow).Value = Range("AT" & currentRow).Value
        End If
        compareRow = compareRow + 1
        DoEvents
    Loop
Next currentRow

Rather than selecting ranges and then cycling through them, this does the same thing without needing to .Select anything. It also breaks out of the inner loop early if it finds a match.

Answer 2

I believe that there are multiple issues here:

1. Efficiency of the search method
2. Loss of responsiveness of Excel

You can dramatically improve the efficiency of the code if you can pull all values into arrays. This prevents the time spent by VBA in accessing the Excel Object model and back. Loss of responsiveness can be handled by using DoEvents . Try the code below. It may look longish but should be easy to understand.

    'Find last row
    Dim lastRow As Variant
    lastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row

    'Create dynamic arrays
    Dim AT() As Variant: Dim AU() As Variant: Dim AV() As Variant
    ReDim AT(2 To lastRow): ReDim AU(2 To lastRow): ReDim AV(2 To lastRow)

    'Get all contents from Excel
    For i = 2 To lastRow
        AT(i) = Worksheets("Sheet1").Cells(i, 46)
        AU(i) = Worksheets("Sheet1").Cells(i, 47)
    Next i

    'Do the comparison
    For c = 2 To lastRow

        For d = 2 To lastRow
            If AT(c) = AU(d) Then AV(c) = AT(c)
        Next d

        'Allow a brief breather to Excel once in a while (don't hang)
        If (c / 100) = Int(c / 100) Then DoEvents

    Next c

    'Place final contents to Excel
    For i = 2 To lastRow
        Worksheets("Sheet1").Cells(i, 48) = AV(i)
    Next i

Answer 3

Try this for your loop:

Dim StartRange As Range, j As Long
Dim CompareRange As Range, i As Range

With Worksheets("Sheet1")
    Set StartRange = .Range("AT1", .Range("AT:AT").Find("*", , , , xlByRows, xlPrevious))
    Set CompareRange = .Range("AU1", .Range("AU:AU").Find("*", , , , xlByRows, xlPrevious))

    For Each i In StartRange
        i.Offset(, -8).Value = .Evaluate("IF(COUNTIF(" & CompareRange.Address(0, 0) & "," & i.Address(0, 0) & ")>0," & i.Value & ","""")")
    Next i
End With

Answer 4

Dim CompareRange As Variant, To_Be_Compared As Variant, j As Variant, k As Variant

Range("AT2").Select
Selection.End(xlDown).Select
Set To_Be_Compared = Range("AT2:" & Selection.Address)
Range("AU2").Select
Selection.End(xlDown).Select
Set CompareRange = Range("AU2:" & Selection.Address)


To_Be_Compared.Select

    For Each j In Selection
        DoEvents
        For Each k In CompareRange
            If j = k Then j.Offset(0, 2) = j
        Next k
    Next j

Answer 5

I finally got it to work, after taking the suggestions and implementing them into my code, I was able to see where the mistake actually was, I was referencing the wrong column earlier in the code and through this, created no duplicate entries to match, so after fixing this, the matches now appear, I ended up offsetting them, and changing the value to "yes" to reflect the duplication in my chart.

Thank you all for the help.